Skip to content

R
riscv-gcc-1
Commit 63ee5404 by Janne Blomqvist
Options

PR 82869 Introduce logical_type_node and use it 

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 these issues by introducing a type
logical_type_node which is a Fortran LOGICAL variable of default
kind. It is then used in places were the Fortran standard mandates, as
well as for compiler generated temporary variables.

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.

gcc/fortran/ChangeLog:

2017-11-08  Janne Blomqvist  <jb@gcc.gnu.org>

	PR 82869
	* convert.c (truthvalue_conversion): Use logical_type_node.
	* trans-array.c (gfc_trans_allocate_array_storage): Likewise.
	(gfc_trans_create_temp_array): Likewise.
	(gfc_trans_array_ctor_element): Likewise.
	(gfc_trans_array_constructor_value): Likewise.
	(trans_array_constructor): Likewise.
	(trans_array_bound_check): Likewise.
	(gfc_conv_array_ref): Likewise.
	(gfc_trans_scalarized_loop_end): Likewise.
	(gfc_conv_array_extent_dim): Likewise.
	(gfc_array_init_size): Likewise.
	(gfc_array_allocate): Likewise.
	(gfc_trans_array_bounds): Likewise.
	(gfc_trans_dummy_array_bias): Likewise.
	(gfc_conv_array_parameter): Likewise.
	(duplicate_allocatable): Likewise.
	(duplicate_allocatable_coarray): Likewise.
	(structure_alloc_comps): Likewise
	(get_std_lbound): Likewise
	(gfc_alloc_allocatable_for_assignment): Likewise
	* trans-decl.c (add_argument_checking): Likewise
	(gfc_generate_function_code): Likewise
	* trans-expr.c (gfc_copy_class_to_class): Likewise
	(gfc_trans_class_array_init_assign): Likewise
	(gfc_trans_class_init_assign): Likewise
	(gfc_conv_expr_present): Likewise
	(gfc_conv_substring): Likewise
	(gfc_conv_cst_int_power): Likewise
	(gfc_conv_expr_op): Likewise
	(gfc_conv_procedure_call): Likewise
	(fill_with_spaces): Likewise
	(gfc_trans_string_copy): Likewise
	(gfc_trans_alloc_subarray_assign): Likewise
	(gfc_trans_pointer_assignment): Likewise
	(gfc_trans_scalar_assign): Likewise
	(fcncall_realloc_result): Likewise
	(alloc_scalar_allocatable_for_assignment): Likewise
	(trans_class_assignment): Likewise
	(gfc_trans_assignment_1): Likewise
	* trans-intrinsic.c (build_fixbound_expr): Likewise
	(gfc_conv_intrinsic_aint): Likewise
	(gfc_trans_same_strlen_check): Likewise
	(conv_caf_send): Likewise
	(trans_this_image): Likewise
	(conv_intrinsic_image_status): Likewise
	(trans_image_index): Likewise
	(gfc_conv_intrinsic_bound): Likewise
	(conv_intrinsic_cobound): Likewise
	(gfc_conv_intrinsic_mod): Likewise
	(gfc_conv_intrinsic_dshift): Likewise
	(gfc_conv_intrinsic_dim): Likewise
	(gfc_conv_intrinsic_sign): Likewise
	(gfc_conv_intrinsic_ctime): Likewise
	(gfc_conv_intrinsic_fdate): Likewise
	(gfc_conv_intrinsic_ttynam): Likewise
	(gfc_conv_intrinsic_minmax): Likewise
	(gfc_conv_intrinsic_minmax_char): Likewise
	(gfc_conv_intrinsic_anyall): Likewise
	(gfc_conv_intrinsic_arith): Likewise
	(gfc_conv_intrinsic_minmaxloc): Likewise
	(gfc_conv_intrinsic_minmaxval): Likewise
	(gfc_conv_intrinsic_btest): Likewise
	(gfc_conv_intrinsic_bitcomp): Likewise
	(gfc_conv_intrinsic_shift): Likewise
	(gfc_conv_intrinsic_ishft): Likewise
	(gfc_conv_intrinsic_ishftc): Likewise
	(gfc_conv_intrinsic_leadz): Likewise
	(gfc_conv_intrinsic_trailz): Likewise
	(gfc_conv_intrinsic_mask): Likewise
	(gfc_conv_intrinsic_spacing): Likewise
	(gfc_conv_intrinsic_rrspacing): Likewise
	(gfc_conv_intrinsic_size): Likewise
	(gfc_conv_intrinsic_sizeof): Likewise
	(gfc_conv_intrinsic_transfer): Likewise
	(gfc_conv_allocated): Likewise
	(gfc_conv_associated): Likewise
	(gfc_conv_same_type_as): Likewise
	(gfc_conv_intrinsic_trim): Likewise
	(gfc_conv_intrinsic_repeat): Likewise
	(conv_isocbinding_function): Likewise
	(conv_intrinsic_ieee_is_normal): Likewise
	(conv_intrinsic_ieee_is_negative): Likewise
	(conv_intrinsic_ieee_copy_sign): Likewise
	(conv_intrinsic_move_alloc): Likewise
	* trans-io.c (set_parameter_value_chk): Likewise
	(set_parameter_value_inquire): Likewise
	(set_string): Likewise
	* trans-openmp.c (gfc_walk_alloc_comps): Likewise
	(gfc_omp_clause_default_ctor): Likewise
	(gfc_omp_clause_copy_ctor): Likewise
	(gfc_omp_clause_assign_op): Likewise
	(gfc_omp_clause_dtor): Likewise
	(gfc_omp_finish_clause): Likewise
	(gfc_trans_omp_clauses): Likewise
	(gfc_trans_omp_do): Likewise
	* trans-stmt.c (gfc_trans_goto): Likewise
	(gfc_trans_sync): Likewise
	(gfc_trans_arithmetic_if): Likewise
	(gfc_trans_simple_do): Likewise
	(gfc_trans_do): Likewise
	(gfc_trans_forall_loop): Likewise
	(gfc_trans_where_2): Likewise
	(gfc_trans_allocate): Likewise
	(gfc_trans_deallocate): Likewise
	* trans-types.c (gfc_init_types): Initialize logical_type_node and
	its true/false trees.
	(gfc_get_array_descr_info): Use logical_type_node.
	* trans-types.h (logical_type_node): New tree.
	(logical_true_node): Likewise.
	(logical_false_node): Likewise.
	* trans.c (gfc_trans_runtime_check): Use logical_type_node.
	(gfc_call_malloc): Likewise
	(gfc_allocate_using_malloc): Likewise
	(gfc_allocate_allocatable): Likewise
	(gfc_add_comp_finalizer_call): Likewise
	(gfc_add_finalizer_call): Likewise
	(gfc_deallocate_with_status): Likewise
	(gfc_deallocate_scalar_with_status): Likewise
	(gfc_call_realloc): Likewise

gcc/testsuite/ChangeLog:

2017-11-08  Janne Blomqvist  <jb@gcc.gnu.org>

	PR 82869
	* gfortran.dg/logical_temp_io.f90: New test.
	* gfortran.dg/logical_temp_io_kind8.f90: New test.

From-SVN: r254526
parent c8ce479d
Showing with 277 additions and 91 deletions
gcc/fortran/ChangeLog
2017-11-06 Paul Thomas <pault@gcc.gnu.org> 2017-11-08 Janne Blomqvist <jb@gcc.gnu.org>
PR 82869
* convert.c (truthvalue_conversion): Use logical_type_node.
* trans-array.c (gfc_trans_allocate_array_storage): Likewise.
(gfc_trans_create_temp_array): Likewise.
(gfc_trans_array_ctor_element): Likewise.
(gfc_trans_array_constructor_value): Likewise.
(trans_array_constructor): Likewise.
(trans_array_bound_check): Likewise.
(gfc_conv_array_ref): Likewise.
(gfc_trans_scalarized_loop_end): Likewise.
(gfc_conv_array_extent_dim): Likewise.
(gfc_array_init_size): Likewise.
(gfc_array_allocate): Likewise.
(gfc_trans_array_bounds): Likewise.
(gfc_trans_dummy_array_bias): Likewise.
(gfc_conv_array_parameter): Likewise.
(duplicate_allocatable): Likewise.
(duplicate_allocatable_coarray): Likewise.
(structure_alloc_comps): Likewise
(get_std_lbound): Likewise
(gfc_alloc_allocatable_for_assignment): Likewise
* trans-decl.c (add_argument_checking): Likewise
(gfc_generate_function_code): Likewise
* trans-expr.c (gfc_copy_class_to_class): Likewise
(gfc_trans_class_array_init_assign): Likewise
(gfc_trans_class_init_assign): Likewise
(gfc_conv_expr_present): Likewise
(gfc_conv_substring): Likewise
(gfc_conv_cst_int_power): Likewise
(gfc_conv_expr_op): Likewise
(gfc_conv_procedure_call): Likewise
(fill_with_spaces): Likewise
(gfc_trans_string_copy): Likewise
(gfc_trans_alloc_subarray_assign): Likewise
(gfc_trans_pointer_assignment): Likewise
(gfc_trans_scalar_assign): Likewise
(fcncall_realloc_result): Likewise
(alloc_scalar_allocatable_for_assignment): Likewise
(trans_class_assignment): Likewise
(gfc_trans_assignment_1): Likewise
* trans-intrinsic.c (build_fixbound_expr): Likewise
(gfc_conv_intrinsic_aint): Likewise
(gfc_trans_same_strlen_check): Likewise
(conv_caf_send): Likewise
(trans_this_image): Likewise
(conv_intrinsic_image_status): Likewise
(trans_image_index): Likewise
(gfc_conv_intrinsic_bound): Likewise
(conv_intrinsic_cobound): Likewise
(gfc_conv_intrinsic_mod): Likewise
(gfc_conv_intrinsic_dshift): Likewise
(gfc_conv_intrinsic_dim): Likewise
(gfc_conv_intrinsic_sign): Likewise
(gfc_conv_intrinsic_ctime): Likewise
(gfc_conv_intrinsic_fdate): Likewise
(gfc_conv_intrinsic_ttynam): Likewise
(gfc_conv_intrinsic_minmax): Likewise
(gfc_conv_intrinsic_minmax_char): Likewise
(gfc_conv_intrinsic_anyall): Likewise
(gfc_conv_intrinsic_arith): Likewise
(gfc_conv_intrinsic_minmaxloc): Likewise
(gfc_conv_intrinsic_minmaxval): Likewise
(gfc_conv_intrinsic_btest): Likewise
(gfc_conv_intrinsic_bitcomp): Likewise
(gfc_conv_intrinsic_shift): Likewise
(gfc_conv_intrinsic_ishft): Likewise
(gfc_conv_intrinsic_ishftc): Likewise
(gfc_conv_intrinsic_leadz): Likewise
(gfc_conv_intrinsic_trailz): Likewise
(gfc_conv_intrinsic_mask): Likewise
(gfc_conv_intrinsic_spacing): Likewise
(gfc_conv_intrinsic_rrspacing): Likewise
(gfc_conv_intrinsic_size): Likewise
(gfc_conv_intrinsic_sizeof): Likewise
(gfc_conv_intrinsic_transfer): Likewise
(gfc_conv_allocated): Likewise
(gfc_conv_associated): Likewise
(gfc_conv_same_type_as): Likewise
(gfc_conv_intrinsic_trim): Likewise
(gfc_conv_intrinsic_repeat): Likewise
(conv_isocbinding_function): Likewise
(conv_intrinsic_ieee_is_normal): Likewise
(conv_intrinsic_ieee_is_negative): Likewise
(conv_intrinsic_ieee_copy_sign): Likewise
(conv_intrinsic_move_alloc): Likewise
* trans-io.c (set_parameter_value_chk): Likewise
(set_parameter_value_inquire): Likewise
(set_string): Likewise
* trans-openmp.c (gfc_walk_alloc_comps): Likewise
(gfc_omp_clause_default_ctor): Likewise
(gfc_omp_clause_copy_ctor): Likewise
(gfc_omp_clause_assign_op): Likewise
(gfc_omp_clause_dtor): Likewise
(gfc_omp_finish_clause): Likewise
(gfc_trans_omp_clauses): Likewise
(gfc_trans_omp_do): Likewise
* trans-stmt.c (gfc_trans_goto): Likewise
(gfc_trans_sync): Likewise
(gfc_trans_arithmetic_if): Likewise
(gfc_trans_simple_do): Likewise
(gfc_trans_do): Likewise
(gfc_trans_forall_loop): Likewise
(gfc_trans_where_2): Likewise
(gfc_trans_allocate): Likewise
(gfc_trans_deallocate): Likewise
* trans-types.c (gfc_init_types): Initialize logical_type_node and
their true/false trees.
(gfc_get_array_descr_info): Use logical_type_node.
* trans-types.h (logical_type_node): New tree.
(logical_true_node): Likewise.
(logical_false_node): Likewise.
* trans.c (gfc_trans_runtime_check): Use logical_type_node.
(gfc_call_malloc): Likewise
(gfc_allocate_using_malloc): Likewise
(gfc_allocate_allocatable): Likewise
(gfc_add_comp_finalizer_call): Likewise
(gfc_add_finalizer_call): Likewise
(gfc_deallocate_with_status): Likewise
(gfc_deallocate_scalar_with_status): Likewise
(gfc_call_realloc): Likewise
2017-11-06 Paul Thomas <pault@gcc.gnu.org>
PR fortran/69739 PR fortran/69739
* trans-expr.c (gfc_map_intrinsic_function): Return false for * trans-expr.c (gfc_map_intrinsic_function): Return false for
......
gcc/fortran/convert.c
...@@ -29,10 +29,14 @@ along with GCC; see the file COPYING3. If not see ...@@ -29,10 +29,14 @@ along with GCC; see the file COPYING3. If not see
#include "fold-const.h" #include "fold-const.h"
#include "convert.h" #include "convert.h"
#include "gfortran.h"
#include "trans.h"
#include "trans-types.h"
/* Prepare expr to be an argument of a TRUTH_NOT_EXPR, /* Prepare expr to be an argument of a TRUTH_NOT_EXPR,
or validate its data type for a GIMPLE `if' or `while' statement. or validate its data type for a GIMPLE `if' or `while' statement.
The resulting type should always be `boolean_type_node'. */ The resulting type should always be `logical_type_node'. */
static tree static tree
truthvalue_conversion (tree expr) truthvalue_conversion (tree expr)
...@@ -40,25 +44,29 @@ truthvalue_conversion (tree expr) ...@@ -40,25 +44,29 @@ truthvalue_conversion (tree expr)
switch (TREE_CODE (TREE_TYPE (expr))) switch (TREE_CODE (TREE_TYPE (expr)))
{ {
case BOOLEAN_TYPE: case BOOLEAN_TYPE:
if (TREE_TYPE (expr) == boolean_type_node) if (TREE_TYPE (expr) == logical_type_node)
return expr; return expr;
else if (COMPARISON_CLASS_P (expr)) else if (COMPARISON_CLASS_P (expr))
{ {
TREE_TYPE (expr) = boolean_type_node; TREE_TYPE (expr) = logical_type_node;
return expr; return expr;
} }
else if (TREE_CODE (expr) == NOP_EXPR) else if (TREE_CODE (expr) == NOP_EXPR)
return fold_build1_loc (input_location, NOP_EXPR, return fold_build1_loc (input_location, NOP_EXPR,
boolean_type_node, TREE_OPERAND (expr, 0)); logical_type_node,
TREE_OPERAND (expr, 0));
else else
return fold_build1_loc (input_location, NOP_EXPR, boolean_type_node, return fold_build1_loc (input_location, NOP_EXPR,
logical_type_node,
expr); expr);
case INTEGER_TYPE: case INTEGER_TYPE:
if (TREE_CODE (expr) == INTEGER_CST) if (TREE_CODE (expr) == INTEGER_CST)
return integer_zerop (expr) ? boolean_false_node : boolean_true_node; return integer_zerop (expr) ? logical_false_node
: logical_true_node;
else else
return fold_build2_loc (input_location, NE_EXPR, boolean_type_node, return fold_build2_loc (input_location, NE_EXPR,
logical_type_node,
expr, build_int_cst (TREE_TYPE (expr), 0)); expr, build_int_cst (TREE_TYPE (expr), 0));
default: default:
......
gcc/fortran/trans-decl.c
...@@ -5784,7 +5784,7 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym) ...@@ -5784,7 +5784,7 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym)
/* Build the condition. For optional arguments, an actual length /* Build the condition. For optional arguments, an actual length
of 0 is also acceptable if the associated string is NULL, which of 0 is also acceptable if the associated string is NULL, which
means the argument was not passed. */ means the argument was not passed. */
cond = fold_build2_loc (input_location, comparison, boolean_type_node, cond = fold_build2_loc (input_location, comparison, logical_type_node,
cl->passed_length, cl->backend_decl); cl->passed_length, cl->backend_decl);
if (fsym->attr.optional) if (fsym->attr.optional)
{ {
...@@ -5793,7 +5793,7 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym) ...@@ -5793,7 +5793,7 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym)
tree absent_failed; tree absent_failed;
not_0length = fold_build2_loc (input_location, NE_EXPR, not_0length = fold_build2_loc (input_location, NE_EXPR,
boolean_type_node, logical_type_node,
cl->passed_length, cl->passed_length,
build_zero_cst (gfc_charlen_type_node)); build_zero_cst (gfc_charlen_type_node));
/* The symbol needs to be referenced for gfc_get_symbol_decl. */ /* The symbol needs to be referenced for gfc_get_symbol_decl. */
...@@ -5801,11 +5801,11 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym) ...@@ -5801,11 +5801,11 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym)
not_absent = gfc_conv_expr_present (fsym); not_absent = gfc_conv_expr_present (fsym);
absent_failed = fold_build2_loc (input_location, TRUTH_OR_EXPR, absent_failed = fold_build2_loc (input_location, TRUTH_OR_EXPR,
boolean_type_node, not_0length, logical_type_node, not_0length,
not_absent); not_absent);
cond = fold_build2_loc (input_location, TRUTH_AND_EXPR, cond = fold_build2_loc (input_location, TRUTH_AND_EXPR,
boolean_type_node, cond, absent_failed); logical_type_node, cond, absent_failed);
} }
/* Build the runtime check. */ /* Build the runtime check. */
...@@ -6376,13 +6376,13 @@ gfc_generate_function_code (gfc_namespace * ns) ...@@ -6376,13 +6376,13 @@ gfc_generate_function_code (gfc_namespace * ns)
msg = xasprintf ("Recursive call to nonrecursive procedure '%s'", msg = xasprintf ("Recursive call to nonrecursive procedure '%s'",
sym->name); sym->name);
recurcheckvar = gfc_create_var (boolean_type_node, "is_recursive"); recurcheckvar = gfc_create_var (logical_type_node, "is_recursive");
TREE_STATIC (recurcheckvar) = 1; TREE_STATIC (recurcheckvar) = 1;
DECL_INITIAL (recurcheckvar) = boolean_false_node; DECL_INITIAL (recurcheckvar) = logical_false_node;
gfc_add_expr_to_block (&init, recurcheckvar); gfc_add_expr_to_block (&init, recurcheckvar);
gfc_trans_runtime_check (true, false, recurcheckvar, &init, gfc_trans_runtime_check (true, false, recurcheckvar, &init,
&sym->declared_at, msg); &sym->declared_at, msg);
gfc_add_modify (&init, recurcheckvar, boolean_true_node); gfc_add_modify (&init, recurcheckvar, logical_true_node);
free (msg); free (msg);
} }
...@@ -6511,7 +6511,7 @@ gfc_generate_function_code (gfc_namespace * ns) ...@@ -6511,7 +6511,7 @@ gfc_generate_function_code (gfc_namespace * ns)
if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION)
&& !is_recursive && !flag_openmp && recurcheckvar != NULL_TREE) && !is_recursive && !flag_openmp && recurcheckvar != NULL_TREE)
{ {
gfc_add_modify (&cleanup, recurcheckvar, boolean_false_node); gfc_add_modify (&cleanup, recurcheckvar, logical_false_node);
recurcheckvar = NULL; recurcheckvar = NULL;
} }
......
gcc/fortran/trans-io.c
...@@ -581,7 +581,7 @@ set_parameter_value_chk (stmtblock_t *block, bool has_iostat, tree var, ...@@ -581,7 +581,7 @@ set_parameter_value_chk (stmtblock_t *block, bool has_iostat, tree var,
/* UNIT numbers should be greater than the min. */ /* UNIT numbers should be greater than the min. */
i = gfc_validate_kind (BT_INTEGER, 4, false); i = gfc_validate_kind (BT_INTEGER, 4, false);
val = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].pedantic_min_int, 4); val = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].pedantic_min_int, 4);
cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
se.expr, se.expr,
fold_convert (TREE_TYPE (se.expr), val)); fold_convert (TREE_TYPE (se.expr), val));
gfc_trans_io_runtime_check (has_iostat, cond, var, LIBERROR_BAD_UNIT, gfc_trans_io_runtime_check (has_iostat, cond, var, LIBERROR_BAD_UNIT,
...@@ -590,7 +590,7 @@ set_parameter_value_chk (stmtblock_t *block, bool has_iostat, tree var, ...@@ -590,7 +590,7 @@ set_parameter_value_chk (stmtblock_t *block, bool has_iostat, tree var,
/* UNIT numbers should be less than the max. */ /* UNIT numbers should be less than the max. */
val = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].huge, 4); val = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].huge, 4);
cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
se.expr, se.expr,
fold_convert (TREE_TYPE (se.expr), val)); fold_convert (TREE_TYPE (se.expr), val));
gfc_trans_io_runtime_check (has_iostat, cond, var, LIBERROR_BAD_UNIT, gfc_trans_io_runtime_check (has_iostat, cond, var, LIBERROR_BAD_UNIT,
...@@ -641,17 +641,17 @@ set_parameter_value_inquire (stmtblock_t *block, tree var, ...@@ -641,17 +641,17 @@ set_parameter_value_inquire (stmtblock_t *block, tree var,
/* UNIT numbers should be greater than zero. */ /* UNIT numbers should be greater than zero. */
i = gfc_validate_kind (BT_INTEGER, 4, false); i = gfc_validate_kind (BT_INTEGER, 4, false);
cond1 = build2_loc (input_location, LT_EXPR, boolean_type_node, cond1 = build2_loc (input_location, LT_EXPR, logical_type_node,
se.expr, se.expr,
fold_convert (TREE_TYPE (se.expr), fold_convert (TREE_TYPE (se.expr),
integer_zero_node)); integer_zero_node));
/* UNIT numbers should be less than the max. */ /* UNIT numbers should be less than the max. */
val = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].huge, 4); val = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].huge, 4);
cond2 = build2_loc (input_location, GT_EXPR, boolean_type_node, cond2 = build2_loc (input_location, GT_EXPR, logical_type_node,
se.expr, se.expr,
fold_convert (TREE_TYPE (se.expr), val)); fold_convert (TREE_TYPE (se.expr), val));
cond3 = build2_loc (input_location, TRUTH_OR_EXPR, cond3 = build2_loc (input_location, TRUTH_OR_EXPR,
boolean_type_node, cond1, cond2); logical_type_node, cond1, cond2);
gfc_start_block (&newblock); gfc_start_block (&newblock);
...@@ -826,7 +826,7 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var, ...@@ -826,7 +826,7 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var,
gfc_conv_label_variable (&se, e); gfc_conv_label_variable (&se, e);
tmp = GFC_DECL_STRING_LEN (se.expr); tmp = GFC_DECL_STRING_LEN (se.expr);
cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
tmp, build_int_cst (TREE_TYPE (tmp), 0)); tmp, build_int_cst (TREE_TYPE (tmp), 0));
msg = xasprintf ("Label assigned to variable '%s' (%%ld) is not a format " msg = xasprintf ("Label assigned to variable '%s' (%%ld) is not a format "
......
gcc/fortran/trans-openmp.c
...@@ -413,7 +413,7 @@ gfc_walk_alloc_comps (tree decl, tree dest, tree var, ...@@ -413,7 +413,7 @@ gfc_walk_alloc_comps (tree decl, tree dest, tree var,
{ {
tem = fold_convert (pvoid_type_node, tem); tem = fold_convert (pvoid_type_node, tem);
tem = fold_build2_loc (input_location, NE_EXPR, tem = fold_build2_loc (input_location, NE_EXPR,
boolean_type_node, tem, logical_type_node, tem,
null_pointer_node); null_pointer_node);
then_b = build3_loc (input_location, COND_EXPR, void_type_node, then_b = build3_loc (input_location, COND_EXPR, void_type_node,
tem, then_b, tem, then_b,
...@@ -540,7 +540,7 @@ gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer) ...@@ -540,7 +540,7 @@ gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer)
GFC_DESCRIPTOR_TYPE_P (type) GFC_DESCRIPTOR_TYPE_P (type)
? gfc_conv_descriptor_data_get (outer) : outer); ? gfc_conv_descriptor_data_get (outer) : outer);
tem = unshare_expr (tem); tem = unshare_expr (tem);
cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
tem, null_pointer_node); tem, null_pointer_node);
gfc_add_expr_to_block (&block, gfc_add_expr_to_block (&block,
build3_loc (input_location, COND_EXPR, build3_loc (input_location, COND_EXPR,
...@@ -646,7 +646,7 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src) ...@@ -646,7 +646,7 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
build_zero_cst (TREE_TYPE (dest))); build_zero_cst (TREE_TYPE (dest)));
else_b = gfc_finish_block (&cond_block); else_b = gfc_finish_block (&cond_block);
cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
unshare_expr (srcptr), null_pointer_node); unshare_expr (srcptr), null_pointer_node);
gfc_add_expr_to_block (&block, gfc_add_expr_to_block (&block,
build3_loc (input_location, COND_EXPR, build3_loc (input_location, COND_EXPR,
...@@ -699,7 +699,7 @@ gfc_omp_clause_assign_op (tree clause, tree dest, tree src) ...@@ -699,7 +699,7 @@ gfc_omp_clause_assign_op (tree clause, tree dest, tree src)
GFC_DESCRIPTOR_TYPE_P (type) GFC_DESCRIPTOR_TYPE_P (type)
? gfc_conv_descriptor_data_get (dest) : dest); ? gfc_conv_descriptor_data_get (dest) : dest);
tem = unshare_expr (tem); tem = unshare_expr (tem);
cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
tem, null_pointer_node); tem, null_pointer_node);
tem = build3_loc (input_location, COND_EXPR, void_type_node, cond, tem = build3_loc (input_location, COND_EXPR, void_type_node, cond,
then_b, build_empty_stmt (input_location)); then_b, build_empty_stmt (input_location));
...@@ -739,7 +739,7 @@ gfc_omp_clause_assign_op (tree clause, tree dest, tree src) ...@@ -739,7 +739,7 @@ gfc_omp_clause_assign_op (tree clause, tree dest, tree src)
destptr = fold_convert (pvoid_type_node, destptr); destptr = fold_convert (pvoid_type_node, destptr);
gfc_add_modify (&cond_block, ptr, destptr); gfc_add_modify (&cond_block, ptr, destptr);
nonalloc = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, nonalloc = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
destptr, null_pointer_node); destptr, null_pointer_node);
cond = nonalloc; cond = nonalloc;
if (GFC_DESCRIPTOR_TYPE_P (type)) if (GFC_DESCRIPTOR_TYPE_P (type))
...@@ -755,11 +755,11 @@ gfc_omp_clause_assign_op (tree clause, tree dest, tree src) ...@@ -755,11 +755,11 @@ gfc_omp_clause_assign_op (tree clause, tree dest, tree src)
tem = fold_build2_loc (input_location, PLUS_EXPR, tem = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type, tem, gfc_array_index_type, tem,
gfc_conv_descriptor_lbound_get (dest, rank)); gfc_conv_descriptor_lbound_get (dest, rank));
tem = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, tem = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
tem, gfc_conv_descriptor_ubound_get (dest, tem, gfc_conv_descriptor_ubound_get (dest,
rank)); rank));
cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR, cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR,
boolean_type_node, cond, tem); logical_type_node, cond, tem);
} }
} }
...@@ -835,7 +835,7 @@ gfc_omp_clause_assign_op (tree clause, tree dest, tree src) ...@@ -835,7 +835,7 @@ gfc_omp_clause_assign_op (tree clause, tree dest, tree src)
} }
else_b = gfc_finish_block (&cond_block); else_b = gfc_finish_block (&cond_block);
cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
unshare_expr (srcptr), null_pointer_node); unshare_expr (srcptr), null_pointer_node);
gfc_add_expr_to_block (&block, gfc_add_expr_to_block (&block,
build3_loc (input_location, COND_EXPR, build3_loc (input_location, COND_EXPR,
...@@ -1028,7 +1028,7 @@ gfc_omp_clause_dtor (tree clause, tree decl) ...@@ -1028,7 +1028,7 @@ gfc_omp_clause_dtor (tree clause, tree decl)
GFC_DESCRIPTOR_TYPE_P (type) GFC_DESCRIPTOR_TYPE_P (type)
? gfc_conv_descriptor_data_get (decl) : decl); ? gfc_conv_descriptor_data_get (decl) : decl);
tem = unshare_expr (tem); tem = unshare_expr (tem);
tree cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, tree cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
tem, null_pointer_node); tem, null_pointer_node);
tem = build3_loc (input_location, COND_EXPR, void_type_node, cond, tem = build3_loc (input_location, COND_EXPR, void_type_node, cond,
then_b, build_empty_stmt (input_location)); then_b, build_empty_stmt (input_location));
...@@ -1129,7 +1129,7 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p) ...@@ -1129,7 +1129,7 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p)
tem = gfc_conv_descriptor_data_get (decl); tem = gfc_conv_descriptor_data_get (decl);
tem = fold_convert (pvoid_type_node, tem); tem = fold_convert (pvoid_type_node, tem);
cond = fold_build2_loc (input_location, NE_EXPR, cond = fold_build2_loc (input_location, NE_EXPR,
boolean_type_node, tem, null_pointer_node); logical_type_node, tem, null_pointer_node);
gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR, gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR,
void_type_node, cond, void_type_node, cond,
then_b, else_b)); then_b, else_b));
...@@ -2155,7 +2155,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, ...@@ -2155,7 +2155,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
tem = gfc_conv_descriptor_data_get (decl); tem = gfc_conv_descriptor_data_get (decl);
tem = fold_convert (pvoid_type_node, tem); tem = fold_convert (pvoid_type_node, tem);
cond = fold_build2_loc (input_location, NE_EXPR, cond = fold_build2_loc (input_location, NE_EXPR,
boolean_type_node, logical_type_node,
tem, null_pointer_node); tem, null_pointer_node);
gfc_add_expr_to_block (block, gfc_add_expr_to_block (block,
build3_loc (input_location, build3_loc (input_location,
...@@ -3599,7 +3599,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, ...@@ -3599,7 +3599,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
/* The condition should not be folded. */ /* The condition should not be folded. */
TREE_VEC_ELT (cond, i) = build2_loc (input_location, simple > 0 TREE_VEC_ELT (cond, i) = build2_loc (input_location, simple > 0
? LE_EXPR : GE_EXPR, ? LE_EXPR : GE_EXPR,
boolean_type_node, dovar, to); logical_type_node, dovar, to);
TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR, TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR,
type, dovar, step); type, dovar, step);
TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location,
...@@ -3626,7 +3626,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, ...@@ -3626,7 +3626,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
build_int_cst (type, 0)); build_int_cst (type, 0));
/* The condition should not be folded. */ /* The condition should not be folded. */
TREE_VEC_ELT (cond, i) = build2_loc (input_location, LT_EXPR, TREE_VEC_ELT (cond, i) = build2_loc (input_location, LT_EXPR,
boolean_type_node, logical_type_node,
count, tmp); count, tmp);
TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR, TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR,
type, count, type, count,
......
gcc/fortran/trans-types.c
...@@ -62,6 +62,9 @@ tree ppvoid_type_node; ...@@ -62,6 +62,9 @@ tree ppvoid_type_node;
tree pchar_type_node; tree pchar_type_node;
tree pfunc_type_node; tree pfunc_type_node;
tree logical_type_node;
tree logical_true_node;
tree logical_false_node;
tree gfc_charlen_type_node; tree gfc_charlen_type_node;
tree gfc_float128_type_node = NULL_TREE; tree gfc_float128_type_node = NULL_TREE;
...@@ -1003,6 +1006,11 @@ gfc_init_types (void) ...@@ -1003,6 +1006,11 @@ gfc_init_types (void)
wi::mask (n, UNSIGNED, wi::mask (n, UNSIGNED,
TYPE_PRECISION (size_type_node))); TYPE_PRECISION (size_type_node)));
logical_type_node = gfc_get_logical_type (gfc_default_logical_kind);
logical_true_node = build_int_cst (logical_type_node, 1);
logical_false_node = build_int_cst (logical_type_node, 0);
/* ??? Shouldn't this be based on gfc_index_integer_kind or so? */ /* ??? Shouldn't this be based on gfc_index_integer_kind or so? */
gfc_charlen_int_kind = 4; gfc_charlen_int_kind = 4;
gfc_charlen_type_node = gfc_get_int_type (gfc_charlen_int_kind); gfc_charlen_type_node = gfc_get_int_type (gfc_charlen_int_kind);
...@@ -3257,11 +3265,11 @@ gfc_get_array_descr_info (const_tree type, struct array_descr_info *info) ...@@ -3257,11 +3265,11 @@ gfc_get_array_descr_info (const_tree type, struct array_descr_info *info)
t = build1 (NOP_EXPR, build_pointer_type (ptr_type_node), t); t = build1 (NOP_EXPR, build_pointer_type (ptr_type_node), t);
info->data_location = build1 (INDIRECT_REF, ptr_type_node, t); info->data_location = build1 (INDIRECT_REF, ptr_type_node, t);
if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE) if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
info->allocated = build2 (NE_EXPR, boolean_type_node, info->allocated = build2 (NE_EXPR, logical_type_node,
info->data_location, null_pointer_node); info->data_location, null_pointer_node);
else if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER else if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER
|| GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT) || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT)
info->associated = build2 (NE_EXPR, boolean_type_node, info->associated = build2 (NE_EXPR, logical_type_node,
info->data_location, null_pointer_node); info->data_location, null_pointer_node);
if ((GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK if ((GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK
|| GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_CONT) || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_CONT)
......
gcc/fortran/trans-types.h
...@@ -33,6 +33,20 @@ extern GTY(()) tree pchar_type_node; ...@@ -33,6 +33,20 @@ extern GTY(()) tree pchar_type_node;
extern GTY(()) tree gfc_float128_type_node; extern GTY(()) tree gfc_float128_type_node;
extern GTY(()) tree gfc_complex_float128_type_node; extern GTY(()) tree gfc_complex_float128_type_node;
/* logical_type_node is the Fortran LOGICAL type of default kind. In
addition to uses mandated by the Fortran standard, also prefer it
for compiler generated temporary variables, is it avoids some minor
issues with boolean_type_node (the C/C++ _Bool/bool). Namely:
- On x86, partial register stalls with 8/16 bit register access,
and length prefix changes.
- On s390 there is a compare with immediate and jump instruction,
but it works only with 32-bit quantities and not 8-bit such as
boolean_type_node.
*/
extern GTY(()) tree logical_type_node;
extern GTY(()) tree logical_true_node;
extern GTY(()) tree logical_false_node;
/* This is the type used to hold the lengths of character variables. /* This is the type used to hold the lengths of character variables.
It must be the same as the corresponding definition in gfortran.h. */ It must be the same as the corresponding definition in gfortran.h. */
/* TODO: This is still hardcoded as kind=4 in some bits of the compiler /* TODO: This is still hardcoded as kind=4 in some bits of the compiler
......
gcc/fortran/trans.c
...@@ -537,9 +537,9 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock, ...@@ -537,9 +537,9 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
if (once) if (once)
{ {
tmpvar = gfc_create_var (boolean_type_node, "print_warning"); tmpvar = gfc_create_var (logical_type_node, "print_warning");
TREE_STATIC (tmpvar) = 1; TREE_STATIC (tmpvar) = 1;
DECL_INITIAL (tmpvar) = boolean_true_node; DECL_INITIAL (tmpvar) = logical_true_node;
gfc_add_expr_to_block (pblock, tmpvar); gfc_add_expr_to_block (pblock, tmpvar);
} }
...@@ -558,7 +558,7 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock, ...@@ -558,7 +558,7 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
va_end (ap); va_end (ap);
if (once) if (once)
gfc_add_modify (&block, tmpvar, boolean_false_node); gfc_add_modify (&block, tmpvar, logical_false_node);
body = gfc_finish_block (&block); body = gfc_finish_block (&block);
...@@ -611,7 +611,7 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size) ...@@ -611,7 +611,7 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size)
if (gfc_option.rtcheck & GFC_RTCHECK_MEM) if (gfc_option.rtcheck & GFC_RTCHECK_MEM)
{ {
null_result = fold_build2_loc (input_location, EQ_EXPR, null_result = fold_build2_loc (input_location, EQ_EXPR,
boolean_type_node, res, logical_type_node, res,
build_int_cst (pvoid_type_node, 0)); build_int_cst (pvoid_type_node, 0));
msg = gfc_build_addr_expr (pchar_type_node, msg = gfc_build_addr_expr (pchar_type_node,
gfc_build_localized_cstring_const ("Memory allocation failed")); gfc_build_localized_cstring_const ("Memory allocation failed"));
...@@ -697,7 +697,7 @@ gfc_allocate_using_malloc (stmtblock_t * block, tree pointer, ...@@ -697,7 +697,7 @@ gfc_allocate_using_malloc (stmtblock_t * block, tree pointer,
} }
error_cond = fold_build2_loc (input_location, EQ_EXPR, error_cond = fold_build2_loc (input_location, EQ_EXPR,
boolean_type_node, pointer, logical_type_node, pointer,
build_int_cst (prvoid_type_node, 0)); build_int_cst (prvoid_type_node, 0));
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
gfc_unlikely (error_cond, PRED_FORTRAN_FAIL_ALLOC), gfc_unlikely (error_cond, PRED_FORTRAN_FAIL_ALLOC),
...@@ -799,7 +799,7 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, ...@@ -799,7 +799,7 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size,
size = fold_convert (size_type_node, size); size = fold_convert (size_type_node, size);
null_mem = gfc_unlikely (fold_build2_loc (input_location, NE_EXPR, null_mem = gfc_unlikely (fold_build2_loc (input_location, NE_EXPR,
boolean_type_node, mem, logical_type_node, mem,
build_int_cst (type, 0)), build_int_cst (type, 0)),
PRED_FORTRAN_REALLOC); PRED_FORTRAN_REALLOC);
...@@ -877,7 +877,7 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, ...@@ -877,7 +877,7 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size,
{ {
TREE_USED (label_finish) = 1; TREE_USED (label_finish) = 1;
tmp = build1_v (GOTO_EXPR, label_finish); tmp = build1_v (GOTO_EXPR, label_finish);
cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
status, build_zero_cst (TREE_TYPE (status))); status, build_zero_cst (TREE_TYPE (status)));
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
gfc_unlikely (cond, PRED_FORTRAN_FAIL_ALLOC), gfc_unlikely (cond, PRED_FORTRAN_FAIL_ALLOC),
...@@ -1094,12 +1094,12 @@ gfc_add_comp_finalizer_call (stmtblock_t *block, tree decl, gfc_component *comp, ...@@ -1094,12 +1094,12 @@ gfc_add_comp_finalizer_call (stmtblock_t *block, tree decl, gfc_component *comp,
{ {
tmp = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (array)) tmp = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (array))
? gfc_conv_descriptor_data_get (array) : array; ? gfc_conv_descriptor_data_get (array) : array;
cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
tmp, fold_convert (TREE_TYPE (tmp), tmp, fold_convert (TREE_TYPE (tmp),
null_pointer_node)); null_pointer_node));
} }
else else
cond = boolean_true_node; cond = logical_true_node;
if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (array))) if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (array)))
{ {
...@@ -1115,12 +1115,12 @@ gfc_add_comp_finalizer_call (stmtblock_t *block, tree decl, gfc_component *comp, ...@@ -1115,12 +1115,12 @@ gfc_add_comp_finalizer_call (stmtblock_t *block, tree decl, gfc_component *comp,
if (!final_expr) if (!final_expr)
{ {
tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
final_fndecl, final_fndecl,
fold_convert (TREE_TYPE (final_fndecl), fold_convert (TREE_TYPE (final_fndecl),
null_pointer_node)); null_pointer_node));
cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR, cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
boolean_type_node, cond, tmp); logical_type_node, cond, tmp);
} }
if (POINTER_TYPE_P (TREE_TYPE (final_fndecl))) if (POINTER_TYPE_P (TREE_TYPE (final_fndecl)))
...@@ -1216,7 +1216,7 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2) ...@@ -1216,7 +1216,7 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2)
gfc_init_se (&se, NULL); gfc_init_se (&se, NULL);
se.want_pointer = 1; se.want_pointer = 1;
gfc_conv_expr (&se, final_expr); gfc_conv_expr (&se, final_expr);
cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
se.expr, build_int_cst (TREE_TYPE (se.expr), 0)); se.expr, build_int_cst (TREE_TYPE (se.expr), 0));
/* For CLASS(*) not only sym->_vtab->_final can be NULL /* For CLASS(*) not only sym->_vtab->_final can be NULL
...@@ -1234,11 +1234,11 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2) ...@@ -1234,11 +1234,11 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2)
gfc_conv_expr (&se, vptr_expr); gfc_conv_expr (&se, vptr_expr);
gfc_free_expr (vptr_expr); gfc_free_expr (vptr_expr);
cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, cond2 = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
se.expr, se.expr,
build_int_cst (TREE_TYPE (se.expr), 0)); build_int_cst (TREE_TYPE (se.expr), 0));
cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR, cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
boolean_type_node, cond2, cond); logical_type_node, cond2, cond);
} }
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
...@@ -1344,7 +1344,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, ...@@ -1344,7 +1344,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (pointer))) else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (pointer)))
pointer = gfc_conv_descriptor_data_get (pointer); pointer = gfc_conv_descriptor_data_get (pointer);
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, pointer, cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, pointer,
build_int_cst (TREE_TYPE (pointer), 0)); build_int_cst (TREE_TYPE (pointer), 0));
/* When POINTER is NULL, we set STATUS to 1 if it's present, otherwise /* When POINTER is NULL, we set STATUS to 1 if it's present, otherwise
...@@ -1371,7 +1371,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, ...@@ -1371,7 +1371,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
tree cond2; tree cond2;
status_type = TREE_TYPE (TREE_TYPE (status)); status_type = TREE_TYPE (TREE_TYPE (status));
cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, cond2 = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
status, build_int_cst (TREE_TYPE (status), 0)); status, build_int_cst (TREE_TYPE (status), 0));
tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type, tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
fold_build1_loc (input_location, INDIRECT_REF, fold_build1_loc (input_location, INDIRECT_REF,
...@@ -1404,7 +1404,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, ...@@ -1404,7 +1404,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
tree status_type = TREE_TYPE (TREE_TYPE (status)); tree status_type = TREE_TYPE (TREE_TYPE (status));
tree cond2; tree cond2;
cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, cond2 = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
status, status,
build_int_cst (TREE_TYPE (status), 0)); build_int_cst (TREE_TYPE (status), 0));
tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type, tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
...@@ -1467,7 +1467,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, ...@@ -1467,7 +1467,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
TREE_USED (label_finish) = 1; TREE_USED (label_finish) = 1;
tmp = build1_v (GOTO_EXPR, label_finish); tmp = build1_v (GOTO_EXPR, label_finish);
cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, cond2 = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
stat, build_zero_cst (TREE_TYPE (stat))); stat, build_zero_cst (TREE_TYPE (stat)));
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
gfc_unlikely (cond2, PRED_FORTRAN_REALLOC), gfc_unlikely (cond2, PRED_FORTRAN_REALLOC),
...@@ -1503,7 +1503,7 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish, ...@@ -1503,7 +1503,7 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish,
&& comp_ref) && comp_ref)
caf_dereg_type = GFC_CAF_COARRAY_DEALLOCATE_ONLY; caf_dereg_type = GFC_CAF_COARRAY_DEALLOCATE_ONLY;
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, pointer, cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, pointer,
build_int_cst (TREE_TYPE (pointer), 0)); build_int_cst (TREE_TYPE (pointer), 0));
/* When POINTER is NULL, we set STATUS to 1 if it's present, otherwise /* When POINTER is NULL, we set STATUS to 1 if it's present, otherwise
...@@ -1530,7 +1530,7 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish, ...@@ -1530,7 +1530,7 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish,
tree status_type = TREE_TYPE (TREE_TYPE (status)); tree status_type = TREE_TYPE (TREE_TYPE (status));
tree cond2; tree cond2;
cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, cond2 = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
status, build_int_cst (TREE_TYPE (status), 0)); status, build_int_cst (TREE_TYPE (status), 0));
tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type, tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
fold_build1_loc (input_location, INDIRECT_REF, fold_build1_loc (input_location, INDIRECT_REF,
...@@ -1575,7 +1575,7 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish, ...@@ -1575,7 +1575,7 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish,
tree status_type = TREE_TYPE (TREE_TYPE (status)); tree status_type = TREE_TYPE (TREE_TYPE (status));
tree cond2; tree cond2;
cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, cond2 = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
status, status,
build_int_cst (TREE_TYPE (status), 0)); build_int_cst (TREE_TYPE (status), 0));
tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type, tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
...@@ -1625,7 +1625,7 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish, ...@@ -1625,7 +1625,7 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish,
TREE_USED (label_finish) = 1; TREE_USED (label_finish) = 1;
tmp = build1_v (GOTO_EXPR, label_finish); tmp = build1_v (GOTO_EXPR, label_finish);
cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, cond2 = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
stat, build_zero_cst (TREE_TYPE (stat))); stat, build_zero_cst (TREE_TYPE (stat)));
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
gfc_unlikely (cond2, PRED_FORTRAN_REALLOC), gfc_unlikely (cond2, PRED_FORTRAN_REALLOC),
...@@ -1668,11 +1668,11 @@ gfc_call_realloc (stmtblock_t * block, tree mem, tree size) ...@@ -1668,11 +1668,11 @@ gfc_call_realloc (stmtblock_t * block, tree mem, tree size)
builtin_decl_explicit (BUILT_IN_REALLOC), 2, builtin_decl_explicit (BUILT_IN_REALLOC), 2,
fold_convert (pvoid_type_node, mem), size); fold_convert (pvoid_type_node, mem), size);
gfc_add_modify (block, res, fold_convert (type, tmp)); gfc_add_modify (block, res, fold_convert (type, tmp));
null_result = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, null_result = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
res, build_int_cst (pvoid_type_node, 0)); res, build_int_cst (pvoid_type_node, 0));
nonzero = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, size, nonzero = fold_build2_loc (input_location, NE_EXPR, logical_type_node, size,
build_int_cst (size_type_node, 0)); build_int_cst (size_type_node, 0));
null_result = fold_build2_loc (input_location, TRUTH_AND_EXPR, boolean_type_node, null_result = fold_build2_loc (input_location, TRUTH_AND_EXPR, logical_type_node,
null_result, nonzero); null_result, nonzero);
msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const
("Allocation would exceed memory limit")); ("Allocation would exceed memory limit"));
......
gcc/testsuite/ChangeLog
2017-11-08 Janne Blomqvist <jb@gcc.gnu.org>
PR 82869
* gfortran.dg/logical_temp_io.f90: New test.
* gfortran.dg/logical_temp_io_kind8.f90: New test.
2017-11-08 Martin Liska <mliska@suse.cz> 2017-11-08 Martin Liska <mliska@suse.cz>
* gcc.dg/tree-ssa/vrp101.c: Update expected pattern as * gcc.dg/tree-ssa/vrp101.c: Update expected pattern as
......
gcc/testsuite/gfortran.dg/logical_temp_io.f90 0 → 100644
! { dg-do run }
! PR 82869
! A temp variable of type logical was incorrectly transferred
! to the I/O library as a logical type of a different kind.
program pr82869
use, intrinsic :: iso_c_binding
type(c_ptr) :: p = c_null_ptr
character(len=4) :: s
write (s, *) c_associated(p), c_associated(c_null_ptr)
if (s /= ' F F') then
call abort()
end if
end program pr82869
gcc/testsuite/gfortran.dg/logical_temp_io_kind8.f90 0 → 100644
! { dg-do run }
! { dg-options "-fdefault-integer-8" }
! PR 82869
! A temp variable of type logical was incorrectly transferred
! to the I/O library as a logical type of a different kind.
program pr82869_8
use, intrinsic :: iso_c_binding
type(c_ptr) :: p = c_null_ptr
character(len=4) :: s
write (s, *) c_associated(p), c_associated(c_null_ptr)
if (s /= ' F F') then
call abort()
end if
end program pr82869_8
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment