Introduce logical_type_node and use it
Backport from trunk.
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-13 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
gcc/testsuite/ChangeLog:
2017-11-13 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: r254706
This commit is contained in:
Janne Blomqvist
parent
f512f6f96b
commit
62adf57eea
|
|
@ -1,3 +1,126 @@
|
|||
2017-11-13 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>
|
||||
|
||||
Backported from trunk
|
||||
|
|
|
|||
|
|
@ -29,10 +29,14 @@ along with GCC; see the file COPYING3. If not see
|
|||
#include "fold-const.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,
|
||||
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
|
||||
truthvalue_conversion (tree expr)
|
||||
|
|
@ -40,25 +44,29 @@ truthvalue_conversion (tree expr)
|
|||
switch (TREE_CODE (TREE_TYPE (expr)))
|
||||
{
|
||||
case BOOLEAN_TYPE:
|
||||
if (TREE_TYPE (expr) == boolean_type_node)
|
||||
if (TREE_TYPE (expr) == logical_type_node)
|
||||
return expr;
|
||||
else if (COMPARISON_CLASS_P (expr))
|
||||
{
|
||||
TREE_TYPE (expr) = boolean_type_node;
|
||||
TREE_TYPE (expr) = logical_type_node;
|
||||
return expr;
|
||||
}
|
||||
else if (TREE_CODE (expr) == 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
|
||||
return fold_build1_loc (input_location, NOP_EXPR, boolean_type_node,
|
||||
return fold_build1_loc (input_location, NOP_EXPR,
|
||||
logical_type_node,
|
||||
expr);
|
||||
|
||||
case INTEGER_TYPE:
|
||||
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
|
||||
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));
|
||||
|
||||
default:
|
||||
|
|
|
|||
|
|
@ -895,7 +895,7 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post,
|
|||
gfc_add_expr_to_block (&do_copying, tmp);
|
||||
|
||||
was_packed = fold_build2_loc (input_location, EQ_EXPR,
|
||||
boolean_type_node, packed,
|
||||
logical_type_node, packed,
|
||||
source_data);
|
||||
tmp = gfc_finish_block (&do_copying);
|
||||
tmp = build3_v (COND_EXPR, was_packed, tmp,
|
||||
|
|
@ -1163,7 +1163,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
|
|||
to[n], gfc_index_one_node);
|
||||
|
||||
/* Check whether the size for this dimension is negative. */
|
||||
cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node,
|
||||
tmp, gfc_index_zero_node);
|
||||
cond = gfc_evaluate_now (cond, pre);
|
||||
|
||||
|
|
@ -1171,7 +1171,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
|
|||
or_expr = cond;
|
||||
else
|
||||
or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
|
||||
boolean_type_node, or_expr, cond);
|
||||
logical_type_node, or_expr, cond);
|
||||
|
||||
size = fold_build2_loc (input_location, MULT_EXPR,
|
||||
gfc_array_index_type, size, tmp);
|
||||
|
|
@ -1431,7 +1431,7 @@ gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
|
|||
/* Verify that all constructor elements are of the same
|
||||
length. */
|
||||
tree cond = fold_build2_loc (input_location, NE_EXPR,
|
||||
boolean_type_node, first_len_val,
|
||||
logical_type_node, first_len_val,
|
||||
se->string_length);
|
||||
gfc_trans_runtime_check
|
||||
(true, false, cond, &se->pre, &expr->where,
|
||||
|
|
@ -1773,14 +1773,14 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
|
|||
/* Generate the exit condition. Depending on the sign of
|
||||
the step variable we have to generate the correct
|
||||
comparison. */
|
||||
tmp = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
|
||||
step, build_int_cst (TREE_TYPE (step), 0));
|
||||
cond = fold_build3_loc (input_location, COND_EXPR,
|
||||
boolean_type_node, tmp,
|
||||
logical_type_node, tmp,
|
||||
fold_build2_loc (input_location, GT_EXPR,
|
||||
boolean_type_node, shadow_loopvar, end),
|
||||
logical_type_node, shadow_loopvar, end),
|
||||
fold_build2_loc (input_location, LT_EXPR,
|
||||
boolean_type_node, shadow_loopvar, end));
|
||||
logical_type_node, shadow_loopvar, end));
|
||||
tmp = build1_v (GOTO_EXPR, exit_label);
|
||||
TREE_USED (exit_label) = 1;
|
||||
tmp = build3_v (COND_EXPR, cond, tmp,
|
||||
|
|
@ -2288,7 +2288,7 @@ trans_array_constructor (gfc_ss * ss, locus * where)
|
|||
/* Check if the character length is negative. If it is, then
|
||||
set LEN = 0. */
|
||||
neg_len = fold_build2_loc (input_location, LT_EXPR,
|
||||
boolean_type_node, ss_info->string_length,
|
||||
logical_type_node, ss_info->string_length,
|
||||
build_int_cst (gfc_charlen_type_node, 0));
|
||||
/* Print a warning if bounds checking is enabled. */
|
||||
if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
|
||||
|
|
@ -2926,13 +2926,13 @@ trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n,
|
|||
msg = xasprintf ("Index '%%ld' of dimension %d "
|
||||
"outside of expected range (%%ld:%%ld)", n+1);
|
||||
|
||||
fault = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
|
||||
fault = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
|
||||
index, tmp_lo);
|
||||
gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg,
|
||||
fold_convert (long_integer_type_node, index),
|
||||
fold_convert (long_integer_type_node, tmp_lo),
|
||||
fold_convert (long_integer_type_node, tmp_up));
|
||||
fault = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
|
||||
fault = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
|
||||
index, tmp_up);
|
||||
gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg,
|
||||
fold_convert (long_integer_type_node, index),
|
||||
|
|
@ -2951,7 +2951,7 @@ trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n,
|
|||
msg = xasprintf ("Index '%%ld' of dimension %d "
|
||||
"below lower bound of %%ld", n+1);
|
||||
|
||||
fault = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
|
||||
fault = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
|
||||
index, tmp_lo);
|
||||
gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg,
|
||||
fold_convert (long_integer_type_node, index),
|
||||
|
|
@ -3456,7 +3456,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr,
|
|||
tmp = tmpse.expr;
|
||||
}
|
||||
|
||||
cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
|
||||
indexse.expr, tmp);
|
||||
msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' "
|
||||
"below lower bound of %%ld", n+1, var_name);
|
||||
|
|
@ -3481,7 +3481,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr,
|
|||
}
|
||||
|
||||
cond = fold_build2_loc (input_location, GT_EXPR,
|
||||
boolean_type_node, indexse.expr, tmp);
|
||||
logical_type_node, indexse.expr, tmp);
|
||||
msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' "
|
||||
"above upper bound of %%ld", n+1, var_name);
|
||||
gfc_trans_runtime_check (true, false, cond, &se->pre, where, msg,
|
||||
|
|
@ -3726,7 +3726,7 @@ gfc_trans_scalarized_loop_end (gfc_loopinfo * loop, int n,
|
|||
OMP_FOR_INIT (stmt) = init;
|
||||
/* The exit condition. */
|
||||
TREE_VEC_ELT (cond, 0) = build2_loc (input_location, LE_EXPR,
|
||||
boolean_type_node,
|
||||
logical_type_node,
|
||||
loop->loopvar[n], loop->to[n]);
|
||||
SET_EXPR_LOCATION (TREE_VEC_ELT (cond, 0), input_location);
|
||||
OMP_FOR_COND (stmt) = cond;
|
||||
|
|
@ -3761,7 +3761,7 @@ gfc_trans_scalarized_loop_end (gfc_loopinfo * loop, int n,
|
|||
|
||||
/* The exit condition. */
|
||||
cond = fold_build2_loc (input_location, reverse_loop ? LT_EXPR : GT_EXPR,
|
||||
boolean_type_node, loop->loopvar[n], loop->to[n]);
|
||||
logical_type_node, loop->loopvar[n], loop->to[n]);
|
||||
tmp = build1_v (GOTO_EXPR, exit_label);
|
||||
TREE_USED (exit_label) = 1;
|
||||
tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt (input_location));
|
||||
|
|
@ -4193,7 +4193,7 @@ done:
|
|||
check_upper = true;
|
||||
|
||||
/* Zero stride is not allowed. */
|
||||
tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
|
||||
info->stride[dim], gfc_index_zero_node);
|
||||
msg = xasprintf ("Zero stride is not allowed, for dimension %d "
|
||||
"of array '%s'", dim + 1, expr_name);
|
||||
|
|
@ -4216,23 +4216,23 @@ done:
|
|||
/* non_zerosized is true when the selected range is not
|
||||
empty. */
|
||||
stride_pos = fold_build2_loc (input_location, GT_EXPR,
|
||||
boolean_type_node, info->stride[dim],
|
||||
logical_type_node, info->stride[dim],
|
||||
gfc_index_zero_node);
|
||||
tmp = fold_build2_loc (input_location, LE_EXPR, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, LE_EXPR, logical_type_node,
|
||||
info->start[dim], end);
|
||||
stride_pos = fold_build2_loc (input_location, TRUTH_AND_EXPR,
|
||||
boolean_type_node, stride_pos, tmp);
|
||||
logical_type_node, stride_pos, tmp);
|
||||
|
||||
stride_neg = fold_build2_loc (input_location, LT_EXPR,
|
||||
boolean_type_node,
|
||||
logical_type_node,
|
||||
info->stride[dim], gfc_index_zero_node);
|
||||
tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
|
||||
info->start[dim], end);
|
||||
stride_neg = fold_build2_loc (input_location, TRUTH_AND_EXPR,
|
||||
boolean_type_node,
|
||||
logical_type_node,
|
||||
stride_neg, tmp);
|
||||
non_zerosized = fold_build2_loc (input_location, TRUTH_OR_EXPR,
|
||||
boolean_type_node,
|
||||
logical_type_node,
|
||||
stride_pos, stride_neg);
|
||||
|
||||
/* Check the start of the range against the lower and upper
|
||||
|
|
@ -4242,16 +4242,16 @@ done:
|
|||
if (check_upper)
|
||||
{
|
||||
tmp = fold_build2_loc (input_location, LT_EXPR,
|
||||
boolean_type_node,
|
||||
logical_type_node,
|
||||
info->start[dim], lbound);
|
||||
tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR,
|
||||
boolean_type_node,
|
||||
logical_type_node,
|
||||
non_zerosized, tmp);
|
||||
tmp2 = fold_build2_loc (input_location, GT_EXPR,
|
||||
boolean_type_node,
|
||||
logical_type_node,
|
||||
info->start[dim], ubound);
|
||||
tmp2 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
|
||||
boolean_type_node,
|
||||
logical_type_node,
|
||||
non_zerosized, tmp2);
|
||||
msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' "
|
||||
"outside of expected range (%%ld:%%ld)",
|
||||
|
|
@ -4271,10 +4271,10 @@ done:
|
|||
else
|
||||
{
|
||||
tmp = fold_build2_loc (input_location, LT_EXPR,
|
||||
boolean_type_node,
|
||||
logical_type_node,
|
||||
info->start[dim], lbound);
|
||||
tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR,
|
||||
boolean_type_node, non_zerosized, tmp);
|
||||
logical_type_node, non_zerosized, tmp);
|
||||
msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' "
|
||||
"below lower bound of %%ld",
|
||||
dim + 1, expr_name);
|
||||
|
|
@ -4298,15 +4298,15 @@ done:
|
|||
tmp = fold_build2_loc (input_location, MINUS_EXPR,
|
||||
gfc_array_index_type, end, tmp);
|
||||
tmp2 = fold_build2_loc (input_location, LT_EXPR,
|
||||
boolean_type_node, tmp, lbound);
|
||||
logical_type_node, tmp, lbound);
|
||||
tmp2 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
|
||||
boolean_type_node, non_zerosized, tmp2);
|
||||
logical_type_node, non_zerosized, tmp2);
|
||||
if (check_upper)
|
||||
{
|
||||
tmp3 = fold_build2_loc (input_location, GT_EXPR,
|
||||
boolean_type_node, tmp, ubound);
|
||||
logical_type_node, tmp, ubound);
|
||||
tmp3 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
|
||||
boolean_type_node, non_zerosized, tmp3);
|
||||
logical_type_node, non_zerosized, tmp3);
|
||||
msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' "
|
||||
"outside of expected range (%%ld:%%ld)",
|
||||
dim + 1, expr_name);
|
||||
|
|
@ -4352,7 +4352,7 @@ done:
|
|||
if (size[n])
|
||||
{
|
||||
tmp3 = fold_build2_loc (input_location, NE_EXPR,
|
||||
boolean_type_node, tmp, size[n]);
|
||||
logical_type_node, tmp, size[n]);
|
||||
msg = xasprintf ("Array bound mismatch for dimension %d "
|
||||
"of array '%s' (%%ld/%%ld)",
|
||||
dim + 1, expr_name);
|
||||
|
|
@ -5036,7 +5036,7 @@ gfc_conv_array_extent_dim (tree lbound, tree ubound, tree* or_expr)
|
|||
gfc_index_one_node);
|
||||
|
||||
/* Check whether the size for this dimension is negative. */
|
||||
cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, res,
|
||||
cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node, res,
|
||||
gfc_index_zero_node);
|
||||
res = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type, cond,
|
||||
gfc_index_zero_node, res);
|
||||
|
|
@ -5044,7 +5044,7 @@ gfc_conv_array_extent_dim (tree lbound, tree ubound, tree* or_expr)
|
|||
/* Build OR expression. */
|
||||
if (or_expr)
|
||||
*or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
|
||||
boolean_type_node, *or_expr, cond);
|
||||
logical_type_node, *or_expr, cond);
|
||||
|
||||
return res;
|
||||
}
|
||||
|
|
@ -5173,7 +5173,7 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
|
|||
gfc_add_modify (pblock, tmp, gfc_get_dtype (type));
|
||||
}
|
||||
|
||||
or_expr = boolean_false_node;
|
||||
or_expr = logical_false_node;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
|
|
@ -5281,12 +5281,12 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
|
|||
TYPE_MAX_VALUE (gfc_array_index_type)),
|
||||
size);
|
||||
cond = gfc_unlikely (fold_build2_loc (input_location, LT_EXPR,
|
||||
boolean_type_node, tmp, stride),
|
||||
logical_type_node, tmp, stride),
|
||||
PRED_FORTRAN_OVERFLOW);
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond,
|
||||
integer_one_node, integer_zero_node);
|
||||
cond = gfc_unlikely (fold_build2_loc (input_location, EQ_EXPR,
|
||||
boolean_type_node, size,
|
||||
logical_type_node, size,
|
||||
gfc_index_zero_node),
|
||||
PRED_FORTRAN_SIZE_ZERO);
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond,
|
||||
|
|
@ -5382,12 +5382,12 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
|
|||
size_type_node,
|
||||
TYPE_MAX_VALUE (size_type_node), element_size);
|
||||
cond = gfc_unlikely (fold_build2_loc (input_location, LT_EXPR,
|
||||
boolean_type_node, tmp, stride),
|
||||
logical_type_node, tmp, stride),
|
||||
PRED_FORTRAN_OVERFLOW);
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond,
|
||||
integer_one_node, integer_zero_node);
|
||||
cond = gfc_unlikely (fold_build2_loc (input_location, EQ_EXPR,
|
||||
boolean_type_node, element_size,
|
||||
logical_type_node, element_size,
|
||||
build_int_cst (size_type_node, 0)),
|
||||
PRED_FORTRAN_SIZE_ZERO);
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond,
|
||||
|
|
@ -5645,7 +5645,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
|
|||
if (dimension)
|
||||
{
|
||||
cond = gfc_unlikely (fold_build2_loc (input_location, NE_EXPR,
|
||||
boolean_type_node, var_overflow, integer_zero_node),
|
||||
logical_type_node, var_overflow, integer_zero_node),
|
||||
PRED_FORTRAN_OVERFLOW);
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
|
||||
error, gfc_finish_block (&elseblock));
|
||||
|
|
@ -5663,7 +5663,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
|
|||
if (status != NULL_TREE)
|
||||
{
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR,
|
||||
boolean_type_node, status,
|
||||
logical_type_node, status,
|
||||
build_int_cst (TREE_TYPE (status), 0));
|
||||
gfc_add_expr_to_block (&se->pre,
|
||||
fold_build3_loc (input_location, COND_EXPR, void_type_node,
|
||||
|
|
@ -5913,7 +5913,7 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree * poffset,
|
|||
|
||||
/* Make sure that negative size arrays are translated
|
||||
to being zero size. */
|
||||
tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
|
||||
stride, gfc_index_zero_node);
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR,
|
||||
gfc_array_index_type, tmp,
|
||||
|
|
@ -6200,10 +6200,10 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
|
|||
/* For non-constant shape arrays we only check if the first dimension
|
||||
is contiguous. Repacking higher dimensions wouldn't gain us
|
||||
anything as we still don't know the array stride. */
|
||||
partial = gfc_create_var (boolean_type_node, "partial");
|
||||
partial = gfc_create_var (logical_type_node, "partial");
|
||||
TREE_USED (partial) = 1;
|
||||
tmp = gfc_conv_descriptor_stride_get (dumdesc, gfc_rank_cst[0]);
|
||||
tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, tmp,
|
||||
tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, tmp,
|
||||
gfc_index_one_node);
|
||||
gfc_add_modify (&init, partial, tmp);
|
||||
}
|
||||
|
|
@ -6218,7 +6218,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
|
|||
stride = gfc_conv_descriptor_stride_get (dumdesc, gfc_rank_cst[0]);
|
||||
stride = gfc_evaluate_now (stride, &init);
|
||||
|
||||
tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
|
||||
stride, gfc_index_zero_node);
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type,
|
||||
tmp, gfc_index_one_node, stride);
|
||||
|
|
@ -6459,7 +6459,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
|
|||
else
|
||||
tmp = build_fold_indirect_ref_loc (input_location, dumdesc);
|
||||
tmp = gfc_conv_descriptor_data_get (tmp);
|
||||
tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
|
||||
tmp, tmpdesc);
|
||||
stmtCleanup = build3_v (COND_EXPR, tmp, stmtCleanup,
|
||||
build_empty_stmt (input_location));
|
||||
|
|
@ -7723,12 +7723,12 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
|
|||
tmp = build_fold_indirect_ref_loc (input_location,
|
||||
desc);
|
||||
tmp = gfc_conv_array_data (tmp);
|
||||
tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
|
||||
fold_convert (TREE_TYPE (tmp), ptr), tmp);
|
||||
|
||||
if (fsym && fsym->attr.optional && sym && sym->attr.optional)
|
||||
tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR,
|
||||
boolean_type_node,
|
||||
logical_type_node,
|
||||
gfc_conv_expr_present (sym), tmp);
|
||||
|
||||
gfc_trans_runtime_check (false, true, tmp, &se->pre,
|
||||
|
|
@ -7758,12 +7758,12 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
|
|||
tmp = build_fold_indirect_ref_loc (input_location,
|
||||
desc);
|
||||
tmp = gfc_conv_array_data (tmp);
|
||||
tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
|
||||
fold_convert (TREE_TYPE (tmp), ptr), tmp);
|
||||
|
||||
if (fsym && fsym->attr.optional && sym && sym->attr.optional)
|
||||
tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR,
|
||||
boolean_type_node,
|
||||
logical_type_node,
|
||||
gfc_conv_expr_present (sym), tmp);
|
||||
|
||||
tmp = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt (input_location));
|
||||
|
|
@ -7902,7 +7902,7 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank,
|
|||
null_cond = gfc_conv_descriptor_data_get (src);
|
||||
|
||||
null_cond = convert (pvoid_type_node, null_cond);
|
||||
null_cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
|
||||
null_cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
|
||||
null_cond, null_pointer_node);
|
||||
return build3_v (COND_EXPR, null_cond, tmp, null_data);
|
||||
}
|
||||
|
|
@ -8036,7 +8036,7 @@ duplicate_allocatable_coarray (tree dest, tree dest_tok, tree src,
|
|||
null_cond = gfc_conv_descriptor_data_get (src);
|
||||
|
||||
null_cond = convert (pvoid_type_node, null_cond);
|
||||
null_cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
|
||||
null_cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
|
||||
null_cond, null_pointer_node);
|
||||
gfc_add_expr_to_block (&globalblock, build3_v (COND_EXPR, null_cond, tmp,
|
||||
null_data));
|
||||
|
|
@ -8148,7 +8148,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
|
|||
|
||||
null_cond = gfc_conv_descriptor_data_get (decl);
|
||||
null_cond = fold_build2_loc (input_location, NE_EXPR,
|
||||
boolean_type_node, null_cond,
|
||||
logical_type_node, null_cond,
|
||||
build_int_cst (TREE_TYPE (null_cond), 0));
|
||||
}
|
||||
else
|
||||
|
|
@ -8386,7 +8386,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
|
|||
dealloc_fndecl);
|
||||
tmp = build_int_cst (TREE_TYPE (comp), 0);
|
||||
is_allocated = fold_build2_loc (input_location, NE_EXPR,
|
||||
boolean_type_node, tmp,
|
||||
logical_type_node, tmp,
|
||||
comp);
|
||||
cdesc = gfc_build_addr_expr (NULL_TREE, cdesc);
|
||||
|
||||
|
|
@ -8666,7 +8666,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
|
|||
null_data = gfc_finish_block (&tmpblock);
|
||||
|
||||
null_cond = fold_build2_loc (input_location, NE_EXPR,
|
||||
boolean_type_node, src_data,
|
||||
logical_type_node, src_data,
|
||||
null_pointer_node);
|
||||
|
||||
gfc_add_expr_to_block (&fnblock, build3_v (COND_EXPR, null_cond,
|
||||
|
|
@ -8841,25 +8841,25 @@ get_std_lbound (gfc_expr *expr, tree desc, int dim, bool assumed_size)
|
|||
lbound = gfc_conv_descriptor_lbound_get (desc, tmp);
|
||||
ubound = gfc_conv_descriptor_ubound_get (desc, tmp);
|
||||
stride = gfc_conv_descriptor_stride_get (desc, tmp);
|
||||
cond1 = fold_build2_loc (input_location, GE_EXPR, boolean_type_node,
|
||||
cond1 = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
|
||||
ubound, lbound);
|
||||
cond3 = fold_build2_loc (input_location, GE_EXPR, boolean_type_node,
|
||||
cond3 = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
|
||||
stride, gfc_index_zero_node);
|
||||
cond3 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
|
||||
boolean_type_node, cond3, cond1);
|
||||
cond4 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
|
||||
logical_type_node, cond3, cond1);
|
||||
cond4 = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
|
||||
stride, gfc_index_zero_node);
|
||||
if (assumed_size)
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
|
||||
tmp, build_int_cst (gfc_array_index_type,
|
||||
expr->rank - 1));
|
||||
else
|
||||
cond = boolean_false_node;
|
||||
cond = logical_false_node;
|
||||
|
||||
cond1 = fold_build2_loc (input_location, TRUTH_OR_EXPR,
|
||||
boolean_type_node, cond3, cond4);
|
||||
logical_type_node, cond3, cond4);
|
||||
cond = fold_build2_loc (input_location, TRUTH_OR_EXPR,
|
||||
boolean_type_node, cond, cond1);
|
||||
logical_type_node, cond, cond1);
|
||||
|
||||
return fold_build3_loc (input_location, COND_EXPR,
|
||||
gfc_array_index_type, cond,
|
||||
|
|
@ -9112,11 +9112,11 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
|
|||
jump_label2 = gfc_build_label_decl (NULL_TREE);
|
||||
|
||||
/* Allocate if data is NULL. */
|
||||
cond_null = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
|
||||
cond_null = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
|
||||
array1, build_int_cst (TREE_TYPE (array1), 0));
|
||||
|
||||
if (expr1->ts.deferred)
|
||||
cond_null = gfc_evaluate_now (boolean_true_node, &fblock);
|
||||
cond_null = gfc_evaluate_now (logical_true_node, &fblock);
|
||||
else
|
||||
cond_null= gfc_evaluate_now (cond_null, &fblock);
|
||||
|
||||
|
|
@ -9156,7 +9156,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
|
|||
gfc_array_index_type,
|
||||
tmp, ubound);
|
||||
cond = fold_build2_loc (input_location, NE_EXPR,
|
||||
boolean_type_node,
|
||||
logical_type_node,
|
||||
tmp, gfc_index_zero_node);
|
||||
tmp = build3_v (COND_EXPR, cond,
|
||||
build1_v (GOTO_EXPR, jump_label1),
|
||||
|
|
@ -9206,13 +9206,13 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
|
|||
}
|
||||
size2 = gfc_evaluate_now (size2, &fblock);
|
||||
|
||||
cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
|
||||
size1, size2);
|
||||
|
||||
/* If the lhs is deferred length, assume that the element size
|
||||
changes and force a reallocation. */
|
||||
if (expr1->ts.deferred)
|
||||
neq_size = gfc_evaluate_now (boolean_true_node, &fblock);
|
||||
neq_size = gfc_evaluate_now (logical_true_node, &fblock);
|
||||
else
|
||||
neq_size = gfc_evaluate_now (cond, &fblock);
|
||||
|
||||
|
|
@ -9492,7 +9492,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
|
|||
/* Malloc if not allocated; realloc otherwise. */
|
||||
tmp = build_int_cst (TREE_TYPE (array1), 0);
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR,
|
||||
boolean_type_node,
|
||||
logical_type_node,
|
||||
array1, tmp);
|
||||
tmp = build3_v (COND_EXPR, cond, alloc_expr, realloc_expr);
|
||||
gfc_add_expr_to_block (&fblock, tmp);
|
||||
|
|
|
|||
|
|
@ -5698,7 +5698,7 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym)
|
|||
/* Build the condition. For optional arguments, an actual length
|
||||
of 0 is also acceptable if the associated string is NULL, which
|
||||
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);
|
||||
if (fsym->attr.optional)
|
||||
{
|
||||
|
|
@ -5707,7 +5707,7 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym)
|
|||
tree absent_failed;
|
||||
|
||||
not_0length = fold_build2_loc (input_location, NE_EXPR,
|
||||
boolean_type_node,
|
||||
logical_type_node,
|
||||
cl->passed_length,
|
||||
build_zero_cst (gfc_charlen_type_node));
|
||||
/* The symbol needs to be referenced for gfc_get_symbol_decl. */
|
||||
|
|
@ -5715,11 +5715,11 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym)
|
|||
not_absent = gfc_conv_expr_present (fsym);
|
||||
|
||||
absent_failed = fold_build2_loc (input_location, TRUTH_OR_EXPR,
|
||||
boolean_type_node, not_0length,
|
||||
logical_type_node, not_0length,
|
||||
not_absent);
|
||||
|
||||
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. */
|
||||
|
|
@ -6290,13 +6290,13 @@ gfc_generate_function_code (gfc_namespace * ns)
|
|||
|
||||
msg = xasprintf ("Recursive call to nonrecursive procedure '%s'",
|
||||
sym->name);
|
||||
recurcheckvar = gfc_create_var (boolean_type_node, "is_recursive");
|
||||
recurcheckvar = gfc_create_var (logical_type_node, "is_recursive");
|
||||
TREE_STATIC (recurcheckvar) = 1;
|
||||
DECL_INITIAL (recurcheckvar) = boolean_false_node;
|
||||
DECL_INITIAL (recurcheckvar) = logical_false_node;
|
||||
gfc_add_expr_to_block (&init, recurcheckvar);
|
||||
gfc_trans_runtime_check (true, false, recurcheckvar, &init,
|
||||
&sym->declared_at, msg);
|
||||
gfc_add_modify (&init, recurcheckvar, boolean_true_node);
|
||||
gfc_add_modify (&init, recurcheckvar, logical_true_node);
|
||||
free (msg);
|
||||
}
|
||||
|
||||
|
|
@ -6425,7 +6425,7 @@ gfc_generate_function_code (gfc_namespace * ns)
|
|||
if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION)
|
||||
&& !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;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -1287,7 +1287,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
|
|||
|
||||
from_len = gfc_conv_descriptor_size (from_data, 1);
|
||||
tmp = fold_build2_loc (input_location, NE_EXPR,
|
||||
boolean_type_node, from_len, orig_nelems);
|
||||
logical_type_node, from_len, orig_nelems);
|
||||
msg = xasprintf ("Array bound mismatch for dimension %d "
|
||||
"of array '%s' (%%ld/%%ld)",
|
||||
1, name);
|
||||
|
|
@ -1338,7 +1338,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
|
|||
extcopy = gfc_finish_block (&ifbody);
|
||||
|
||||
tmp = fold_build2_loc (input_location, GT_EXPR,
|
||||
boolean_type_node, from_len,
|
||||
logical_type_node, from_len,
|
||||
integer_zero_node);
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR,
|
||||
void_type_node, tmp, extcopy, stdcopy);
|
||||
|
|
@ -1366,7 +1366,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
|
|||
vec_safe_push (args, to_len);
|
||||
extcopy = build_call_vec (fcn_type, fcn, args);
|
||||
tmp = fold_build2_loc (input_location, GT_EXPR,
|
||||
boolean_type_node, from_len,
|
||||
logical_type_node, from_len,
|
||||
integer_zero_node);
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR,
|
||||
void_type_node, tmp, extcopy, stdcopy);
|
||||
|
|
@ -1380,7 +1380,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
|
|||
{
|
||||
tree cond;
|
||||
cond = fold_build2_loc (input_location, NE_EXPR,
|
||||
boolean_type_node,
|
||||
logical_type_node,
|
||||
from_data, null_pointer_node);
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR,
|
||||
void_type_node, cond,
|
||||
|
|
@ -1425,7 +1425,7 @@ gfc_trans_class_array_init_assign (gfc_expr *rhs, gfc_expr *lhs, gfc_expr *obj)
|
|||
gfc_init_se (&src, NULL);
|
||||
gfc_conv_expr (&src, rhs);
|
||||
src.expr = gfc_build_addr_expr (NULL_TREE, src.expr);
|
||||
tree cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
|
||||
tree cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
|
||||
src.expr, fold_convert (TREE_TYPE (src.expr),
|
||||
null_pointer_node));
|
||||
res = build3_loc (input_location, COND_EXPR, TREE_TYPE (res), cond, res,
|
||||
|
|
@ -1492,7 +1492,7 @@ gfc_trans_class_init_assign (gfc_code *code)
|
|||
{
|
||||
/* Check if _def_init is non-NULL. */
|
||||
tree cond = fold_build2_loc (input_location, NE_EXPR,
|
||||
boolean_type_node, src.expr,
|
||||
logical_type_node, src.expr,
|
||||
fold_convert (TREE_TYPE (src.expr),
|
||||
null_pointer_node));
|
||||
tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp), cond,
|
||||
|
|
@ -1662,7 +1662,7 @@ gfc_conv_expr_present (gfc_symbol * sym)
|
|||
decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
|
||||
}
|
||||
|
||||
cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, decl,
|
||||
cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, decl,
|
||||
fold_convert (TREE_TYPE (decl), null_pointer_node));
|
||||
|
||||
/* Fortran 2008 allows to pass null pointers and non-associated pointers
|
||||
|
|
@ -1699,10 +1699,10 @@ gfc_conv_expr_present (gfc_symbol * sym)
|
|||
|
||||
if (tmp != NULL_TREE)
|
||||
{
|
||||
tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, tmp,
|
||||
tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp,
|
||||
fold_convert (TREE_TYPE (tmp), null_pointer_node));
|
||||
cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
|
||||
boolean_type_node, cond, tmp);
|
||||
logical_type_node, cond, tmp);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -2264,15 +2264,15 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
|
|||
if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
|
||||
{
|
||||
tree nonempty = fold_build2_loc (input_location, LE_EXPR,
|
||||
boolean_type_node, start.expr,
|
||||
logical_type_node, start.expr,
|
||||
end.expr);
|
||||
|
||||
/* Check lower bound. */
|
||||
fault = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
|
||||
fault = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
|
||||
start.expr,
|
||||
build_int_cst (gfc_charlen_type_node, 1));
|
||||
fault = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
|
||||
boolean_type_node, nonempty, fault);
|
||||
logical_type_node, nonempty, fault);
|
||||
if (name)
|
||||
msg = xasprintf ("Substring out of bounds: lower bound (%%ld) of '%s' "
|
||||
"is less than one", name);
|
||||
|
|
@ -2285,10 +2285,10 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
|
|||
free (msg);
|
||||
|
||||
/* Check upper bound. */
|
||||
fault = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
|
||||
fault = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
|
||||
end.expr, se->string_length);
|
||||
fault = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
|
||||
boolean_type_node, nonempty, fault);
|
||||
logical_type_node, nonempty, fault);
|
||||
if (name)
|
||||
msg = xasprintf ("Substring out of bounds: upper bound (%%ld) of '%s' "
|
||||
"exceeds string length (%%ld)", name);
|
||||
|
|
@ -2890,9 +2890,9 @@ gfc_conv_cst_int_power (gfc_se * se, tree lhs, tree rhs)
|
|||
/* If rhs < 0 and lhs is an integer, the result is -1, 0 or 1. */
|
||||
if ((sgn == -1) && (TREE_CODE (type) == INTEGER_TYPE))
|
||||
{
|
||||
tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
|
||||
lhs, build_int_cst (TREE_TYPE (lhs), -1));
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
|
||||
lhs, build_int_cst (TREE_TYPE (lhs), 1));
|
||||
|
||||
/* If rhs is even,
|
||||
|
|
@ -2900,7 +2900,7 @@ gfc_conv_cst_int_power (gfc_se * se, tree lhs, tree rhs)
|
|||
if ((n & 1) == 0)
|
||||
{
|
||||
tmp = fold_build2_loc (input_location, TRUTH_OR_EXPR,
|
||||
boolean_type_node, tmp, cond);
|
||||
logical_type_node, tmp, cond);
|
||||
se->expr = fold_build3_loc (input_location, COND_EXPR, type,
|
||||
tmp, build_int_cst (type, 1),
|
||||
build_int_cst (type, 0));
|
||||
|
|
@ -3386,8 +3386,8 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr)
|
|||
|
||||
if (lop)
|
||||
{
|
||||
/* The result of logical ops is always boolean_type_node. */
|
||||
tmp = fold_build2_loc (input_location, code, boolean_type_node,
|
||||
/* The result of logical ops is always logical_type_node. */
|
||||
tmp = fold_build2_loc (input_location, code, logical_type_node,
|
||||
lse.expr, rse.expr);
|
||||
se->expr = convert (type, tmp);
|
||||
}
|
||||
|
|
@ -4985,7 +4985,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
|
|||
tree descriptor_data;
|
||||
|
||||
descriptor_data = ss->info->data.array.data;
|
||||
tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
|
||||
descriptor_data,
|
||||
fold_convert (TREE_TYPE (descriptor_data),
|
||||
null_pointer_node));
|
||||
|
|
@ -5149,7 +5149,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
|
|||
tree cond;
|
||||
tmp = gfc_build_addr_expr (NULL_TREE, parmse.expr);
|
||||
cond = fold_build2_loc (input_location, NE_EXPR,
|
||||
boolean_type_node, tmp,
|
||||
logical_type_node, tmp,
|
||||
fold_convert (TREE_TYPE (tmp),
|
||||
null_pointer_node));
|
||||
gfc_start_block (&block);
|
||||
|
|
@ -5680,16 +5680,16 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
|
|||
present = gfc_conv_expr_present (e->symtree->n.sym);
|
||||
type = TREE_TYPE (present);
|
||||
present = fold_build2_loc (input_location, EQ_EXPR,
|
||||
boolean_type_node, present,
|
||||
logical_type_node, present,
|
||||
fold_convert (type,
|
||||
null_pointer_node));
|
||||
type = TREE_TYPE (parmse.expr);
|
||||
null_ptr = fold_build2_loc (input_location, EQ_EXPR,
|
||||
boolean_type_node, parmse.expr,
|
||||
logical_type_node, parmse.expr,
|
||||
fold_convert (type,
|
||||
null_pointer_node));
|
||||
cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR,
|
||||
boolean_type_node, present, null_ptr);
|
||||
logical_type_node, present, null_ptr);
|
||||
}
|
||||
else
|
||||
{
|
||||
|
|
@ -5716,7 +5716,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
|
|||
tmp = gfc_build_addr_expr (NULL_TREE, tmp);
|
||||
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR,
|
||||
boolean_type_node, tmp,
|
||||
logical_type_node, tmp,
|
||||
fold_convert (TREE_TYPE (tmp),
|
||||
null_pointer_node));
|
||||
}
|
||||
|
|
@ -6211,7 +6211,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
|
|||
happen in a function returning a pointer. */
|
||||
tmp = gfc_conv_descriptor_data_get (info->descriptor);
|
||||
tmp = fold_build2_loc (input_location, NE_EXPR,
|
||||
boolean_type_node,
|
||||
logical_type_node,
|
||||
tmp, info->data);
|
||||
gfc_trans_runtime_check (true, false, tmp, &se->pre, NULL,
|
||||
gfc_msg_fault);
|
||||
|
|
@ -6337,7 +6337,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
|
|||
|
||||
final_fndecl = gfc_class_vtab_final_get (se->expr);
|
||||
is_final = fold_build2_loc (input_location, NE_EXPR,
|
||||
boolean_type_node,
|
||||
logical_type_node,
|
||||
final_fndecl,
|
||||
fold_convert (TREE_TYPE (final_fndecl),
|
||||
null_pointer_node));
|
||||
|
|
@ -6411,7 +6411,7 @@ fill_with_spaces (tree start, tree type, tree size)
|
|||
gfc_init_block (&loop);
|
||||
|
||||
/* Exit condition. */
|
||||
cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, i,
|
||||
cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node, i,
|
||||
build_zero_cst (sizetype));
|
||||
tmp = build1_v (GOTO_EXPR, exit_label);
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, tmp,
|
||||
|
|
@ -6504,7 +6504,7 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
|
|||
*/
|
||||
|
||||
/* Do nothing if the destination length is zero. */
|
||||
cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, dlen,
|
||||
cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node, dlen,
|
||||
build_int_cst (size_type_node, 0));
|
||||
|
||||
/* For non-default character kinds, we have to multiply the string
|
||||
|
|
@ -6540,7 +6540,7 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
|
|||
gfc_add_expr_to_block (&tmpblock2, tmp2);
|
||||
|
||||
/* If the destination is longer, fill the end with spaces. */
|
||||
cond2 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, slen,
|
||||
cond2 = fold_build2_loc (input_location, LT_EXPR, logical_type_node, slen,
|
||||
dlen);
|
||||
|
||||
/* Wstringop-overflow appears at -O3 even though this warning is not
|
||||
|
|
@ -7125,7 +7125,7 @@ gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm,
|
|||
null_pointer_node);
|
||||
null_expr = gfc_finish_block (&block);
|
||||
tmp = gfc_conv_descriptor_data_get (arg->symtree->n.sym->backend_decl);
|
||||
tmp = build2_loc (input_location, EQ_EXPR, boolean_type_node, tmp,
|
||||
tmp = build2_loc (input_location, EQ_EXPR, logical_type_node, tmp,
|
||||
fold_convert (TREE_TYPE (tmp), null_pointer_node));
|
||||
return build3_v (COND_EXPR, tmp,
|
||||
null_expr, non_null_expr);
|
||||
|
|
@ -8666,7 +8666,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
|
|||
|
||||
lsize = gfc_evaluate_now (lsize, &block);
|
||||
rsize = gfc_evaluate_now (rsize, &block);
|
||||
fault = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
|
||||
fault = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
|
||||
rsize, lsize);
|
||||
|
||||
msg = _("Target of rank remapping is too small (%ld < %ld)");
|
||||
|
|
@ -8785,7 +8785,7 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
|
|||
/* Are the rhs and the lhs the same? */
|
||||
if (deep_copy)
|
||||
{
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
|
||||
gfc_build_addr_expr (NULL_TREE, lse->expr),
|
||||
gfc_build_addr_expr (NULL_TREE, rse->expr));
|
||||
cond = gfc_evaluate_now (cond, &lse->pre);
|
||||
|
|
@ -9060,7 +9060,7 @@ fcncall_realloc_result (gfc_se *se, int rank)
|
|||
the lhs descriptor. */
|
||||
tmp = gfc_conv_descriptor_data_get (desc);
|
||||
zero_cond = fold_build2_loc (input_location, EQ_EXPR,
|
||||
boolean_type_node, tmp,
|
||||
logical_type_node, tmp,
|
||||
build_int_cst (TREE_TYPE (tmp), 0));
|
||||
zero_cond = gfc_evaluate_now (zero_cond, &se->post);
|
||||
tmp = gfc_call_free (tmp);
|
||||
|
|
@ -9084,11 +9084,11 @@ fcncall_realloc_result (gfc_se *se, int rank)
|
|||
tmp = fold_build2_loc (input_location, PLUS_EXPR,
|
||||
gfc_array_index_type, tmp, tmp1);
|
||||
tmp = fold_build2_loc (input_location, NE_EXPR,
|
||||
boolean_type_node, tmp,
|
||||
logical_type_node, tmp,
|
||||
gfc_index_zero_node);
|
||||
tmp = gfc_evaluate_now (tmp, &se->post);
|
||||
zero_cond = fold_build2_loc (input_location, TRUTH_OR_EXPR,
|
||||
boolean_type_node, tmp,
|
||||
logical_type_node, tmp,
|
||||
zero_cond);
|
||||
}
|
||||
|
||||
|
|
@ -9527,7 +9527,7 @@ alloc_scalar_allocatable_for_assignment (stmtblock_t *block,
|
|||
|
||||
/* Do the allocation if the lhs is NULL. Otherwise go to label 1. */
|
||||
tmp = build_int_cst (TREE_TYPE (lse.expr), 0);
|
||||
cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
|
||||
lse.expr, tmp);
|
||||
tmp = build3_v (COND_EXPR, cond,
|
||||
build1_v (GOTO_EXPR, jump_label1),
|
||||
|
|
@ -9605,7 +9605,7 @@ alloc_scalar_allocatable_for_assignment (stmtblock_t *block,
|
|||
rhs are different. */
|
||||
if (expr1->ts.type == BT_CHARACTER && expr1->ts.deferred)
|
||||
{
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
|
||||
lse.string_length, size);
|
||||
/* Jump past the realloc if the lengths are the same. */
|
||||
tmp = build3_v (COND_EXPR, cond,
|
||||
|
|
@ -9751,7 +9751,7 @@ trans_class_assignment (stmtblock_t *block, gfc_expr *lhs, gfc_expr *rhs,
|
|||
gfc_init_block (&alloc);
|
||||
gfc_allocate_using_malloc (&alloc, class_han, tmp, NULL_TREE);
|
||||
tmp = fold_build2_loc (input_location, EQ_EXPR,
|
||||
boolean_type_node, class_han,
|
||||
logical_type_node, class_han,
|
||||
build_int_cst (prvoid_type_node, 0));
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
|
||||
gfc_unlikely (tmp,
|
||||
|
|
@ -9804,7 +9804,7 @@ trans_class_assignment (stmtblock_t *block, gfc_expr *lhs, gfc_expr *rhs,
|
|||
extcopy = build_call_vec (TREE_TYPE (TREE_TYPE (fcn)), fcn, args);
|
||||
|
||||
tmp = fold_build2_loc (input_location, GT_EXPR,
|
||||
boolean_type_node, from_len,
|
||||
logical_type_node, from_len,
|
||||
integer_zero_node);
|
||||
return fold_build3_loc (input_location, COND_EXPR,
|
||||
void_type_node, tmp,
|
||||
|
|
@ -10033,7 +10033,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
|
|||
if (TREE_CODE (lse.expr) == ARRAY_REF)
|
||||
tmp = gfc_build_addr_expr (NULL_TREE, tmp);
|
||||
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
|
||||
tmp, build_int_cst (TREE_TYPE (tmp), 0));
|
||||
msg = _("Assignment of scalar to unallocated array");
|
||||
gfc_trans_runtime_check (true, false, cond, &loop.pre,
|
||||
|
|
|
|||
|
|
@ -358,7 +358,7 @@ build_fixbound_expr (stmtblock_t * pblock, tree arg, tree type, int up)
|
|||
|
||||
tmp = convert (argtype, intval);
|
||||
cond = fold_build2_loc (input_location, up ? GE_EXPR : LE_EXPR,
|
||||
boolean_type_node, tmp, arg);
|
||||
logical_type_node, tmp, arg);
|
||||
|
||||
tmp = fold_build2_loc (input_location, up ? PLUS_EXPR : MINUS_EXPR, type,
|
||||
intval, build_int_cst (type, 1));
|
||||
|
|
@ -490,14 +490,14 @@ gfc_conv_intrinsic_aint (gfc_se * se, gfc_expr * expr, enum rounding_mode op)
|
|||
n = gfc_validate_kind (BT_INTEGER, kind, false);
|
||||
mpfr_set_z (huge, gfc_integer_kinds[n].huge, GFC_RND_MODE);
|
||||
tmp = gfc_conv_mpfr_to_tree (huge, kind, 0);
|
||||
cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, arg[0],
|
||||
cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node, arg[0],
|
||||
tmp);
|
||||
|
||||
mpfr_neg (huge, huge, GFC_RND_MODE);
|
||||
tmp = gfc_conv_mpfr_to_tree (huge, kind, 0);
|
||||
tmp = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, arg[0],
|
||||
tmp = fold_build2_loc (input_location, GT_EXPR, logical_type_node, arg[0],
|
||||
tmp);
|
||||
cond = fold_build2_loc (input_location, TRUTH_AND_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, TRUTH_AND_EXPR, logical_type_node,
|
||||
cond, tmp);
|
||||
itype = gfc_get_int_type (kind);
|
||||
|
||||
|
|
@ -885,7 +885,7 @@ gfc_trans_same_strlen_check (const char* intr_name, locus* where,
|
|||
return;
|
||||
|
||||
/* Compare the two string lengths. */
|
||||
cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, a, b);
|
||||
cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, a, b);
|
||||
|
||||
/* Output the runtime-check. */
|
||||
name = gfc_build_cstring_const (intr_name);
|
||||
|
|
@ -1962,7 +1962,7 @@ conv_caf_send (gfc_code *code) {
|
|||
TYPE_SIZE_UNIT (
|
||||
gfc_typenode_for_spec (&lhs_expr->ts)),
|
||||
NULL_TREE);
|
||||
tmp = fold_build2 (EQ_EXPR, boolean_type_node, scal_se.expr,
|
||||
tmp = fold_build2 (EQ_EXPR, logical_type_node, scal_se.expr,
|
||||
null_pointer_node);
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
|
||||
tmp, gfc_finish_block (&scal_se.pre),
|
||||
|
|
@ -2254,14 +2254,14 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
|
|||
else if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
|
||||
{
|
||||
dim_arg = gfc_evaluate_now (dim_arg, &se->pre);
|
||||
cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
|
||||
dim_arg,
|
||||
build_int_cst (TREE_TYPE (dim_arg), 1));
|
||||
tmp = gfc_rank_cst[GFC_TYPE_ARRAY_CORANK (TREE_TYPE (desc))];
|
||||
tmp = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
|
||||
dim_arg, tmp);
|
||||
cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR,
|
||||
boolean_type_node, cond, tmp);
|
||||
logical_type_node, cond, tmp);
|
||||
gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where,
|
||||
gfc_msg_fault);
|
||||
}
|
||||
|
|
@ -2352,7 +2352,7 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
|
|||
m, extent));
|
||||
|
||||
/* Exit condition: if (i >= min_var) goto exit_label. */
|
||||
cond = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, loop_var,
|
||||
cond = fold_build2_loc (input_location, GE_EXPR, logical_type_node, loop_var,
|
||||
min_var);
|
||||
tmp = build1_v (GOTO_EXPR, exit_label);
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, tmp,
|
||||
|
|
@ -2377,7 +2377,7 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
|
|||
/* sub(co_dim) = (co_dim < corank) ? ml - m*extent + lcobound(dim_arg)
|
||||
: m + lcobound(corank) */
|
||||
|
||||
cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, dim_arg,
|
||||
cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node, dim_arg,
|
||||
build_int_cst (TREE_TYPE (dim_arg), corank));
|
||||
|
||||
lbound = gfc_conv_descriptor_lbound_get (desc,
|
||||
|
|
@ -2415,7 +2415,7 @@ conv_intrinsic_image_status (gfc_se *se, gfc_expr *expr)
|
|||
{
|
||||
tree arg;
|
||||
arg = gfc_evaluate_now (args[0], &se->pre);
|
||||
tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
|
||||
fold_convert (integer_type_node, arg),
|
||||
integer_one_node);
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node,
|
||||
|
|
@ -2466,7 +2466,7 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
|
|||
|
||||
lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[rank+corank-1]);
|
||||
tmp = gfc_build_array_ref (subdesc, gfc_rank_cst[corank-1], NULL);
|
||||
invalid_bound = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
|
||||
invalid_bound = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
|
||||
fold_convert (gfc_array_index_type, tmp),
|
||||
lbound);
|
||||
|
||||
|
|
@ -2475,16 +2475,16 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
|
|||
lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[codim]);
|
||||
ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[codim]);
|
||||
tmp = gfc_build_array_ref (subdesc, gfc_rank_cst[codim-rank], NULL);
|
||||
cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
|
||||
fold_convert (gfc_array_index_type, tmp),
|
||||
lbound);
|
||||
invalid_bound = fold_build2_loc (input_location, TRUTH_OR_EXPR,
|
||||
boolean_type_node, invalid_bound, cond);
|
||||
cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
|
||||
logical_type_node, invalid_bound, cond);
|
||||
cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
|
||||
fold_convert (gfc_array_index_type, tmp),
|
||||
ubound);
|
||||
invalid_bound = fold_build2_loc (input_location, TRUTH_OR_EXPR,
|
||||
boolean_type_node, invalid_bound, cond);
|
||||
logical_type_node, invalid_bound, cond);
|
||||
}
|
||||
|
||||
invalid_bound = gfc_unlikely (invalid_bound, PRED_FORTRAN_INVALID_BOUND);
|
||||
|
|
@ -2544,11 +2544,11 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
|
|||
tmp = gfc_create_var (type, NULL);
|
||||
gfc_add_modify (&se->pre, tmp, coindex);
|
||||
|
||||
cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, tmp,
|
||||
cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node, tmp,
|
||||
num_images);
|
||||
cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, logical_type_node,
|
||||
cond,
|
||||
fold_convert (boolean_type_node, invalid_bound));
|
||||
fold_convert (logical_type_node, invalid_bound));
|
||||
se->expr = fold_build3_loc (input_location, COND_EXPR, type, cond,
|
||||
build_int_cst (type, 0), tmp);
|
||||
}
|
||||
|
|
@ -2679,16 +2679,16 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
|
|||
if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
|
||||
{
|
||||
bound = gfc_evaluate_now (bound, &se->pre);
|
||||
cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
|
||||
bound, build_int_cst (TREE_TYPE (bound), 0));
|
||||
if (as && as->type == AS_ASSUMED_RANK)
|
||||
tmp = gfc_conv_descriptor_rank (desc);
|
||||
else
|
||||
tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))];
|
||||
tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
|
||||
bound, fold_convert(TREE_TYPE (bound), tmp));
|
||||
cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR,
|
||||
boolean_type_node, cond, tmp);
|
||||
logical_type_node, cond, tmp);
|
||||
gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where,
|
||||
gfc_msg_fault);
|
||||
}
|
||||
|
|
@ -2734,27 +2734,27 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
|
|||
{
|
||||
tree stride = gfc_conv_descriptor_stride_get (desc, bound);
|
||||
|
||||
cond1 = fold_build2_loc (input_location, GE_EXPR, boolean_type_node,
|
||||
cond1 = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
|
||||
ubound, lbound);
|
||||
cond3 = fold_build2_loc (input_location, GE_EXPR, boolean_type_node,
|
||||
cond3 = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
|
||||
stride, gfc_index_zero_node);
|
||||
cond3 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
|
||||
boolean_type_node, cond3, cond1);
|
||||
cond4 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
|
||||
logical_type_node, cond3, cond1);
|
||||
cond4 = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
|
||||
stride, gfc_index_zero_node);
|
||||
|
||||
if (upper)
|
||||
{
|
||||
tree cond5;
|
||||
cond = fold_build2_loc (input_location, TRUTH_OR_EXPR,
|
||||
boolean_type_node, cond3, cond4);
|
||||
cond5 = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
|
||||
logical_type_node, cond3, cond4);
|
||||
cond5 = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
|
||||
gfc_index_one_node, lbound);
|
||||
cond5 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
|
||||
boolean_type_node, cond4, cond5);
|
||||
logical_type_node, cond4, cond5);
|
||||
|
||||
cond = fold_build2_loc (input_location, TRUTH_OR_EXPR,
|
||||
boolean_type_node, cond, cond5);
|
||||
logical_type_node, cond, cond5);
|
||||
|
||||
if (assumed_rank_lb_one)
|
||||
{
|
||||
|
|
@ -2773,16 +2773,16 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
|
|||
else
|
||||
{
|
||||
if (as->type == AS_ASSUMED_SIZE)
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
|
||||
bound, build_int_cst (TREE_TYPE (bound),
|
||||
arg->expr->rank - 1));
|
||||
else
|
||||
cond = boolean_false_node;
|
||||
cond = logical_false_node;
|
||||
|
||||
cond1 = fold_build2_loc (input_location, TRUTH_OR_EXPR,
|
||||
boolean_type_node, cond3, cond4);
|
||||
logical_type_node, cond3, cond4);
|
||||
cond = fold_build2_loc (input_location, TRUTH_OR_EXPR,
|
||||
boolean_type_node, cond, cond1);
|
||||
logical_type_node, cond, cond1);
|
||||
|
||||
se->expr = fold_build3_loc (input_location, COND_EXPR,
|
||||
gfc_array_index_type, cond,
|
||||
|
|
@ -2872,13 +2872,13 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
|
|||
else if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
|
||||
{
|
||||
bound = gfc_evaluate_now (bound, &se->pre);
|
||||
cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
|
||||
bound, build_int_cst (TREE_TYPE (bound), 1));
|
||||
tmp = gfc_rank_cst[GFC_TYPE_ARRAY_CORANK (TREE_TYPE (desc))];
|
||||
tmp = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
|
||||
bound, tmp);
|
||||
cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR,
|
||||
boolean_type_node, cond, tmp);
|
||||
logical_type_node, cond, tmp);
|
||||
gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where,
|
||||
gfc_msg_fault);
|
||||
}
|
||||
|
|
@ -2947,7 +2947,7 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
|
|||
|
||||
if (corank > 1)
|
||||
{
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
|
||||
bound,
|
||||
build_int_cst (TREE_TYPE (bound),
|
||||
arg->expr->rank + corank - 1));
|
||||
|
|
@ -3136,16 +3136,16 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo)
|
|||
tmp = gfc_evaluate_now (se->expr, &se->pre);
|
||||
if (!flag_signed_zeros)
|
||||
{
|
||||
test = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
|
||||
test = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
|
||||
args[0], zero);
|
||||
test2 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
|
||||
test2 = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
|
||||
args[1], zero);
|
||||
test2 = fold_build2_loc (input_location, TRUTH_XOR_EXPR,
|
||||
boolean_type_node, test, test2);
|
||||
test = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
|
||||
logical_type_node, test, test2);
|
||||
test = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
|
||||
tmp, zero);
|
||||
test = fold_build2_loc (input_location, TRUTH_AND_EXPR,
|
||||
boolean_type_node, test, test2);
|
||||
logical_type_node, test, test2);
|
||||
test = gfc_evaluate_now (test, &se->pre);
|
||||
se->expr = fold_build3_loc (input_location, COND_EXPR, type, test,
|
||||
fold_build2_loc (input_location,
|
||||
|
|
@ -3158,18 +3158,18 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo)
|
|||
tree expr1, copysign, cscall;
|
||||
copysign = gfc_builtin_decl_for_float_kind (BUILT_IN_COPYSIGN,
|
||||
expr->ts.kind);
|
||||
test = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
|
||||
test = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
|
||||
args[0], zero);
|
||||
test2 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
|
||||
test2 = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
|
||||
args[1], zero);
|
||||
test2 = fold_build2_loc (input_location, TRUTH_XOR_EXPR,
|
||||
boolean_type_node, test, test2);
|
||||
logical_type_node, test, test2);
|
||||
expr1 = fold_build3_loc (input_location, COND_EXPR, type, test2,
|
||||
fold_build2_loc (input_location,
|
||||
PLUS_EXPR,
|
||||
type, tmp, args[1]),
|
||||
tmp);
|
||||
test = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
|
||||
test = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
|
||||
tmp, zero);
|
||||
cscall = build_call_expr_loc (input_location, copysign, 2, zero,
|
||||
args[1]);
|
||||
|
|
@ -3225,12 +3225,12 @@ gfc_conv_intrinsic_dshift (gfc_se * se, gfc_expr * expr, bool dshiftl)
|
|||
res = fold_build2_loc (input_location, BIT_IOR_EXPR, type, left, right);
|
||||
|
||||
/* Special cases. */
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, shift,
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, shift,
|
||||
build_int_cst (stype, 0));
|
||||
res = fold_build3_loc (input_location, COND_EXPR, type, cond,
|
||||
dshiftl ? arg1 : arg2, res);
|
||||
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, shift,
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, shift,
|
||||
build_int_cst (stype, bitsize));
|
||||
res = fold_build3_loc (input_location, COND_EXPR, type, cond,
|
||||
dshiftl ? arg2 : arg1, res);
|
||||
|
|
@ -3257,7 +3257,7 @@ gfc_conv_intrinsic_dim (gfc_se * se, gfc_expr * expr)
|
|||
val = gfc_evaluate_now (val, &se->pre);
|
||||
|
||||
zero = gfc_build_const (type, integer_zero_node);
|
||||
tmp = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, val, zero);
|
||||
tmp = fold_build2_loc (input_location, LE_EXPR, logical_type_node, val, zero);
|
||||
se->expr = fold_build3_loc (input_location, COND_EXPR, type, tmp, zero, val);
|
||||
}
|
||||
|
||||
|
|
@ -3290,7 +3290,7 @@ gfc_conv_intrinsic_sign (gfc_se * se, gfc_expr * expr)
|
|||
{
|
||||
tree cond, zero;
|
||||
zero = build_real_from_int_cst (TREE_TYPE (args[1]), integer_zero_node);
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
|
||||
args[1], zero);
|
||||
se->expr = fold_build3_loc (input_location, COND_EXPR,
|
||||
TREE_TYPE (args[0]), cond,
|
||||
|
|
@ -3411,7 +3411,7 @@ gfc_conv_intrinsic_ctime (gfc_se * se, gfc_expr * expr)
|
|||
gfc_add_expr_to_block (&se->pre, tmp);
|
||||
|
||||
/* Free the temporary afterwards, if necessary. */
|
||||
cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
|
||||
len, build_int_cst (TREE_TYPE (len), 0));
|
||||
tmp = gfc_call_free (var);
|
||||
tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt (input_location));
|
||||
|
|
@ -3450,7 +3450,7 @@ gfc_conv_intrinsic_fdate (gfc_se * se, gfc_expr * expr)
|
|||
gfc_add_expr_to_block (&se->pre, tmp);
|
||||
|
||||
/* Free the temporary afterwards, if necessary. */
|
||||
cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
|
||||
len, build_int_cst (TREE_TYPE (len), 0));
|
||||
tmp = gfc_call_free (var);
|
||||
tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt (input_location));
|
||||
|
|
@ -3660,7 +3660,7 @@ gfc_conv_intrinsic_ttynam (gfc_se * se, gfc_expr * expr)
|
|||
gfc_add_expr_to_block (&se->pre, tmp);
|
||||
|
||||
/* Free the temporary afterwards, if necessary. */
|
||||
cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
|
||||
len, build_int_cst (TREE_TYPE (len), 0));
|
||||
tmp = gfc_call_free (var);
|
||||
tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt (input_location));
|
||||
|
|
@ -3724,7 +3724,7 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
&& argexpr->expr->symtree->n.sym->attr.optional
|
||||
&& TREE_CODE (val) == INDIRECT_REF)
|
||||
cond = fold_build2_loc (input_location,
|
||||
NE_EXPR, boolean_type_node,
|
||||
NE_EXPR, logical_type_node,
|
||||
TREE_OPERAND (val, 0),
|
||||
build_int_cst (TREE_TYPE (TREE_OPERAND (val, 0)), 0));
|
||||
else
|
||||
|
|
@ -3738,7 +3738,7 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
|
||||
thencase = build2_v (MODIFY_EXPR, mvar, convert (type, val));
|
||||
|
||||
tmp = fold_build2_loc (input_location, op, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, op, logical_type_node,
|
||||
convert (type, val), mvar);
|
||||
|
||||
/* FIXME: When the IEEE_ARITHMETIC module is implemented, the call to
|
||||
|
|
@ -3750,8 +3750,8 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
builtin_decl_explicit (BUILT_IN_ISNAN),
|
||||
1, mvar);
|
||||
tmp = fold_build2_loc (input_location, TRUTH_OR_EXPR,
|
||||
boolean_type_node, tmp,
|
||||
fold_convert (boolean_type_node, isnan));
|
||||
logical_type_node, tmp,
|
||||
fold_convert (logical_type_node, isnan));
|
||||
}
|
||||
tmp = build3_v (COND_EXPR, tmp, thencase,
|
||||
build_empty_stmt (input_location));
|
||||
|
|
@ -3803,7 +3803,7 @@ gfc_conv_intrinsic_minmax_char (gfc_se * se, gfc_expr * expr, int op)
|
|||
gfc_add_expr_to_block (&se->pre, tmp);
|
||||
|
||||
/* Free the temporary afterwards, if necessary. */
|
||||
cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
|
||||
len, build_int_cst (TREE_TYPE (len), 0));
|
||||
tmp = gfc_call_free (var);
|
||||
tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt (input_location));
|
||||
|
|
@ -4003,7 +4003,7 @@ gfc_conv_intrinsic_anyall (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
gfc_conv_expr_val (&arrayse, actual->expr);
|
||||
|
||||
gfc_add_block_to_block (&body, &arrayse.pre);
|
||||
tmp = fold_build2_loc (input_location, op, boolean_type_node, arrayse.expr,
|
||||
tmp = fold_build2_loc (input_location, op, logical_type_node, arrayse.expr,
|
||||
build_int_cst (TREE_TYPE (arrayse.expr), 0));
|
||||
tmp = build3_v (COND_EXPR, tmp, found, build_empty_stmt (input_location));
|
||||
gfc_add_expr_to_block (&body, tmp);
|
||||
|
|
@ -4282,13 +4282,13 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
|
|||
gfc_add_modify (&ifblock3, resvar, res2);
|
||||
res2 = gfc_finish_block (&ifblock3);
|
||||
|
||||
cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
|
||||
absX, scale);
|
||||
tmp = build3_v (COND_EXPR, cond, res1, res2);
|
||||
gfc_add_expr_to_block (&ifblock1, tmp);
|
||||
tmp = gfc_finish_block (&ifblock1);
|
||||
|
||||
cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
|
||||
arrayse.expr,
|
||||
gfc_build_const (type, integer_zero_node));
|
||||
|
||||
|
|
@ -4594,7 +4594,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
nonempty = gfc_conv_mpz_to_tree (asize, gfc_index_integer_kind);
|
||||
mpz_clear (asize);
|
||||
nonempty = fold_build2_loc (input_location, GT_EXPR,
|
||||
boolean_type_node, nonempty,
|
||||
logical_type_node, nonempty,
|
||||
gfc_index_zero_node);
|
||||
}
|
||||
maskss = NULL;
|
||||
|
|
@ -4658,7 +4658,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
|
||||
gcc_assert (loop.dimen == 1);
|
||||
if (nonempty == NULL && maskss == NULL && loop.from[0] && loop.to[0])
|
||||
nonempty = fold_build2_loc (input_location, LE_EXPR, boolean_type_node,
|
||||
nonempty = fold_build2_loc (input_location, LE_EXPR, logical_type_node,
|
||||
loop.from[0], loop.to[0]);
|
||||
|
||||
lab1 = NULL;
|
||||
|
|
@ -4734,7 +4734,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
loop.loopvar[0], offset);
|
||||
gfc_add_modify (&ifblock2, pos, tmp);
|
||||
ifbody2 = gfc_finish_block (&ifblock2);
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, pos,
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, pos,
|
||||
gfc_index_zero_node);
|
||||
tmp = build3_v (COND_EXPR, cond, ifbody2,
|
||||
build_empty_stmt (input_location));
|
||||
|
|
@ -4755,9 +4755,9 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
if (lab1)
|
||||
cond = fold_build2_loc (input_location,
|
||||
op == GT_EXPR ? GE_EXPR : LE_EXPR,
|
||||
boolean_type_node, arrayse.expr, limit);
|
||||
logical_type_node, arrayse.expr, limit);
|
||||
else
|
||||
cond = fold_build2_loc (input_location, op, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, op, logical_type_node,
|
||||
arrayse.expr, limit);
|
||||
|
||||
ifbody = build3_v (COND_EXPR, cond, ifbody,
|
||||
|
|
@ -4828,7 +4828,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
|
||||
ifbody = gfc_finish_block (&ifblock);
|
||||
|
||||
cond = fold_build2_loc (input_location, op, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, op, logical_type_node,
|
||||
arrayse.expr, limit);
|
||||
|
||||
tmp = build3_v (COND_EXPR, cond, ifbody,
|
||||
|
|
@ -5080,7 +5080,7 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
nonempty = gfc_conv_mpz_to_tree (asize, gfc_index_integer_kind);
|
||||
mpz_clear (asize);
|
||||
nonempty = fold_build2_loc (input_location, GT_EXPR,
|
||||
boolean_type_node, nonempty,
|
||||
logical_type_node, nonempty,
|
||||
gfc_index_zero_node);
|
||||
}
|
||||
maskss = NULL;
|
||||
|
|
@ -5114,15 +5114,15 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
|
||||
if (nonempty == NULL && maskss == NULL
|
||||
&& loop.dimen == 1 && loop.from[0] && loop.to[0])
|
||||
nonempty = fold_build2_loc (input_location, LE_EXPR, boolean_type_node,
|
||||
nonempty = fold_build2_loc (input_location, LE_EXPR, logical_type_node,
|
||||
loop.from[0], loop.to[0]);
|
||||
nonempty_var = NULL;
|
||||
if (nonempty == NULL
|
||||
&& (HONOR_INFINITIES (DECL_MODE (limit))
|
||||
|| HONOR_NANS (DECL_MODE (limit))))
|
||||
{
|
||||
nonempty_var = gfc_create_var (boolean_type_node, "nonempty");
|
||||
gfc_add_modify (&se->pre, nonempty_var, boolean_false_node);
|
||||
nonempty_var = gfc_create_var (logical_type_node, "nonempty");
|
||||
gfc_add_modify (&se->pre, nonempty_var, logical_false_node);
|
||||
nonempty = nonempty_var;
|
||||
}
|
||||
lab = NULL;
|
||||
|
|
@ -5136,8 +5136,8 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
}
|
||||
else
|
||||
{
|
||||
fast = gfc_create_var (boolean_type_node, "fast");
|
||||
gfc_add_modify (&se->pre, fast, boolean_false_node);
|
||||
fast = gfc_create_var (logical_type_node, "fast");
|
||||
gfc_add_modify (&se->pre, fast, logical_false_node);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -5171,12 +5171,12 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
gfc_init_block (&block2);
|
||||
|
||||
if (nonempty_var)
|
||||
gfc_add_modify (&block2, nonempty_var, boolean_true_node);
|
||||
gfc_add_modify (&block2, nonempty_var, logical_true_node);
|
||||
|
||||
if (HONOR_NANS (DECL_MODE (limit)))
|
||||
{
|
||||
tmp = fold_build2_loc (input_location, op == GT_EXPR ? GE_EXPR : LE_EXPR,
|
||||
boolean_type_node, arrayse.expr, limit);
|
||||
logical_type_node, arrayse.expr, limit);
|
||||
if (lab)
|
||||
ifbody = build1_v (GOTO_EXPR, lab);
|
||||
else
|
||||
|
|
@ -5185,7 +5185,7 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
|
||||
gfc_init_block (&ifblock);
|
||||
gfc_add_modify (&ifblock, limit, arrayse.expr);
|
||||
gfc_add_modify (&ifblock, fast, boolean_true_node);
|
||||
gfc_add_modify (&ifblock, fast, logical_true_node);
|
||||
ifbody = gfc_finish_block (&ifblock);
|
||||
}
|
||||
tmp = build3_v (COND_EXPR, tmp, ifbody,
|
||||
|
|
@ -5198,7 +5198,7 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
signed zeros. */
|
||||
if (HONOR_SIGNED_ZEROS (DECL_MODE (limit)))
|
||||
{
|
||||
tmp = fold_build2_loc (input_location, op, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, op, logical_type_node,
|
||||
arrayse.expr, limit);
|
||||
ifbody = build2_v (MODIFY_EXPR, limit, arrayse.expr);
|
||||
tmp = build3_v (COND_EXPR, tmp, ifbody,
|
||||
|
|
@ -5223,7 +5223,7 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
if (HONOR_NANS (DECL_MODE (limit))
|
||||
|| HONOR_SIGNED_ZEROS (DECL_MODE (limit)))
|
||||
{
|
||||
tmp = fold_build2_loc (input_location, op, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, op, logical_type_node,
|
||||
arrayse.expr, limit);
|
||||
ifbody = build2_v (MODIFY_EXPR, limit, arrayse.expr);
|
||||
ifbody = build3_v (COND_EXPR, tmp, ifbody,
|
||||
|
|
@ -5286,7 +5286,7 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
if (HONOR_NANS (DECL_MODE (limit))
|
||||
|| HONOR_SIGNED_ZEROS (DECL_MODE (limit)))
|
||||
{
|
||||
tmp = fold_build2_loc (input_location, op, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, op, logical_type_node,
|
||||
arrayse.expr, limit);
|
||||
ifbody = build2_v (MODIFY_EXPR, limit, arrayse.expr);
|
||||
tmp = build3_v (COND_EXPR, tmp, ifbody,
|
||||
|
|
@ -5376,7 +5376,7 @@ 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, boolean_type_node, tmp,
|
||||
tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp,
|
||||
build_int_cst (type, 0));
|
||||
type = gfc_typenode_for_spec (&expr->ts);
|
||||
se->expr = convert (type, tmp);
|
||||
|
|
@ -5404,7 +5404,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, boolean_type_node,
|
||||
se->expr = fold_build2_loc (input_location, op, logical_type_node,
|
||||
args[0], args[1]);
|
||||
}
|
||||
|
||||
|
|
@ -5505,7 +5505,7 @@ 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));
|
||||
cond = fold_build2_loc (input_location, GE_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
|
||||
args[1], num_bits);
|
||||
|
||||
se->expr = fold_build3_loc (input_location, COND_EXPR, type, cond,
|
||||
|
|
@ -5551,7 +5551,7 @@ gfc_conv_intrinsic_ishft (gfc_se * se, gfc_expr * expr)
|
|||
rshift = fold_convert (type, fold_build2_loc (input_location, RSHIFT_EXPR,
|
||||
utype, convert (utype, args[0]), width));
|
||||
|
||||
tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, args[1],
|
||||
tmp = fold_build2_loc (input_location, GE_EXPR, logical_type_node, args[1],
|
||||
build_int_cst (TREE_TYPE (args[1]), 0));
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR, type, tmp, lshift, rshift);
|
||||
|
||||
|
|
@ -5559,7 +5559,7 @@ 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));
|
||||
cond = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, width,
|
||||
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,
|
||||
build_int_cst (type, 0), tmp);
|
||||
|
|
@ -5643,12 +5643,12 @@ gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr * expr)
|
|||
rrot = fold_build2_loc (input_location,RROTATE_EXPR, type, args[0], tmp);
|
||||
|
||||
zero = build_int_cst (TREE_TYPE (args[1]), 0);
|
||||
tmp = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, args[1],
|
||||
tmp = fold_build2_loc (input_location, GT_EXPR, logical_type_node, args[1],
|
||||
zero);
|
||||
rrot = fold_build3_loc (input_location, COND_EXPR, type, tmp, lrot, rrot);
|
||||
|
||||
/* Do nothing if shift == 0. */
|
||||
tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, args[1],
|
||||
tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, args[1],
|
||||
zero);
|
||||
se->expr = fold_build3_loc (input_location, COND_EXPR, type, tmp, args[0],
|
||||
rrot);
|
||||
|
|
@ -5746,7 +5746,7 @@ gfc_conv_intrinsic_leadz (gfc_se * se, gfc_expr * expr)
|
|||
fold_convert (arg_type, ullmax), ullsize);
|
||||
cond = fold_build2_loc (input_location, BIT_AND_EXPR, arg_type,
|
||||
arg, cond);
|
||||
cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
|
||||
cond, build_int_cst (arg_type, 0));
|
||||
|
||||
tmp1 = fold_build2_loc (input_location, RSHIFT_EXPR, arg_type,
|
||||
|
|
@ -5770,7 +5770,7 @@ gfc_conv_intrinsic_leadz (gfc_se * se, gfc_expr * expr)
|
|||
/* Build BIT_SIZE. */
|
||||
bit_size = build_int_cst (result_type, argsize);
|
||||
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
|
||||
arg, build_int_cst (arg_type, 0));
|
||||
se->expr = fold_build3_loc (input_location, COND_EXPR, result_type, cond,
|
||||
bit_size, leadz);
|
||||
|
|
@ -5855,7 +5855,7 @@ gfc_conv_intrinsic_trailz (gfc_se * se, gfc_expr *expr)
|
|||
|
||||
cond = fold_build2_loc (input_location, BIT_AND_EXPR, arg_type, arg,
|
||||
fold_convert (arg_type, ullmax));
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, cond,
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, cond,
|
||||
build_int_cst (arg_type, 0));
|
||||
|
||||
tmp1 = fold_build2_loc (input_location, RSHIFT_EXPR, arg_type,
|
||||
|
|
@ -5879,7 +5879,7 @@ gfc_conv_intrinsic_trailz (gfc_se * se, gfc_expr *expr)
|
|||
/* Build BIT_SIZE. */
|
||||
bit_size = build_int_cst (result_type, argsize);
|
||||
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
|
||||
arg, build_int_cst (arg_type, 0));
|
||||
se->expr = fold_build3_loc (input_location, COND_EXPR, result_type, cond,
|
||||
bit_size, trailz);
|
||||
|
|
@ -6312,7 +6312,7 @@ gfc_conv_intrinsic_mask (gfc_se * se, gfc_expr * expr, int left)
|
|||
|
||||
/* Special case arg == 0, because SHIFT_EXPR wants a shift strictly
|
||||
smaller than type width. */
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, arg,
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, arg,
|
||||
build_int_cst (TREE_TYPE (arg), 0));
|
||||
res = fold_build3_loc (input_location, COND_EXPR, utype, cond,
|
||||
build_int_cst (utype, 0), res);
|
||||
|
|
@ -6326,7 +6326,7 @@ gfc_conv_intrinsic_mask (gfc_se * se, gfc_expr * expr, int left)
|
|||
|
||||
/* Special case agr == bit_size, because SHIFT_EXPR wants a shift
|
||||
strictly smaller than type width. */
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
|
||||
arg, bitsize);
|
||||
res = fold_build3_loc (input_location, COND_EXPR, utype,
|
||||
cond, allones, res);
|
||||
|
|
@ -6447,7 +6447,7 @@ gfc_conv_intrinsic_spacing (gfc_se * se, gfc_expr * expr)
|
|||
gfc_add_modify (&block, res, tmp);
|
||||
|
||||
/* Finish by building the IF statement for value zero. */
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, arg,
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, arg,
|
||||
build_real_from_int_cst (type, integer_zero_node));
|
||||
tmp = build3_v (COND_EXPR, cond, build2_v (MODIFY_EXPR, res, tiny),
|
||||
gfc_finish_block (&block));
|
||||
|
|
@ -6518,7 +6518,7 @@ gfc_conv_intrinsic_rrspacing (gfc_se * se, gfc_expr * expr)
|
|||
stmt = gfc_finish_block (&block);
|
||||
|
||||
/* if (x != 0) */
|
||||
cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, x,
|
||||
cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, x,
|
||||
build_real_from_int_cst (type, integer_zero_node));
|
||||
tmp = build3_v (COND_EXPR, cond, stmt, build_empty_stmt (input_location));
|
||||
|
||||
|
|
@ -6648,7 +6648,7 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr)
|
|||
argse.data_not_needed = 1;
|
||||
gfc_conv_expr (&argse, actual->expr);
|
||||
gfc_add_block_to_block (&se->pre, &argse.pre);
|
||||
tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
|
||||
argse.expr, null_pointer_node);
|
||||
tmp = gfc_evaluate_now (tmp, &se->pre);
|
||||
se->expr = fold_build3_loc (input_location, COND_EXPR,
|
||||
|
|
@ -6817,7 +6817,7 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
|
|||
}
|
||||
exit: */
|
||||
gfc_start_block (&body);
|
||||
cond = fold_build2_loc (input_location, GE_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
|
||||
loop_var, tmp);
|
||||
tmp = build1_v (GOTO_EXPR, exit_label);
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
|
||||
|
|
@ -7088,7 +7088,7 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
|
|||
/* Clean up if it was repacked. */
|
||||
gfc_init_block (&block);
|
||||
tmp = gfc_conv_array_data (argse.expr);
|
||||
tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
|
||||
source, tmp);
|
||||
tmp = build3_v (COND_EXPR, tmp, stmt,
|
||||
build_empty_stmt (input_location));
|
||||
|
|
@ -7313,14 +7313,14 @@ scalar_transfer:
|
|||
indirect = gfc_finish_block (&block);
|
||||
|
||||
/* Wrap it up with the condition. */
|
||||
tmp = fold_build2_loc (input_location, LE_EXPR, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, LE_EXPR, logical_type_node,
|
||||
dest_word_len, source_bytes);
|
||||
tmp = build3_v (COND_EXPR, tmp, direct, indirect);
|
||||
gfc_add_expr_to_block (&se->pre, tmp);
|
||||
|
||||
/* Free the temporary string, if necessary. */
|
||||
free = gfc_call_free (tmpdecl);
|
||||
tmp = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
|
||||
dest_word_len, source_bytes);
|
||||
tmp = build3_v (COND_EXPR, tmp, free, build_empty_stmt (input_location));
|
||||
gfc_add_expr_to_block (&se->post, tmp);
|
||||
|
|
@ -7462,7 +7462,7 @@ 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, boolean_type_node, tmp,
|
||||
tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp,
|
||||
fold_convert (TREE_TYPE (tmp), null_pointer_node));
|
||||
}
|
||||
se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp);
|
||||
|
|
@ -7530,7 +7530,7 @@ 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, boolean_type_node, tmp2,
|
||||
tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp2,
|
||||
fold_convert (TREE_TYPE (tmp2), null_pointer_node));
|
||||
se->expr = tmp;
|
||||
}
|
||||
|
|
@ -7543,7 +7543,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,
|
||||
boolean_type_node,
|
||||
logical_type_node,
|
||||
arg1->expr->ts.u.cl->backend_decl,
|
||||
integer_zero_node);
|
||||
if (scalar)
|
||||
|
|
@ -7568,12 +7568,12 @@ 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, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
|
||||
arg1se.expr, arg2se.expr);
|
||||
tmp2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
|
||||
tmp2 = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
|
||||
arg1se.expr, null_pointer_node);
|
||||
se->expr = fold_build2_loc (input_location, TRUTH_AND_EXPR,
|
||||
boolean_type_node, tmp, tmp2);
|
||||
logical_type_node, tmp, tmp2);
|
||||
}
|
||||
else
|
||||
{
|
||||
|
|
@ -7591,7 +7591,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,
|
||||
boolean_type_node, tmp,
|
||||
logical_type_node, tmp,
|
||||
build_int_cst (TREE_TYPE (tmp), 0));
|
||||
|
||||
/* A pointer to an array, call library function _gfor_associated. */
|
||||
|
|
@ -7605,9 +7605,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 (boolean_type_node, se->expr);
|
||||
se->expr = convert (logical_type_node, se->expr);
|
||||
se->expr = fold_build2_loc (input_location, TRUTH_AND_EXPR,
|
||||
boolean_type_node, se->expr,
|
||||
logical_type_node, se->expr,
|
||||
nonzero_arraylen);
|
||||
}
|
||||
|
||||
|
|
@ -7615,7 +7615,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,
|
||||
boolean_type_node,
|
||||
logical_type_node,
|
||||
se->expr, nonzero_charlen);
|
||||
}
|
||||
|
||||
|
|
@ -7643,14 +7643,14 @@ 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, boolean_type_node,
|
||||
conda = fold_build2_loc (input_location, NE_EXPR, 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, boolean_type_node,
|
||||
condb = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
|
||||
tmp, build_int_cst (TREE_TYPE (tmp), 0));
|
||||
}
|
||||
|
||||
|
|
@ -7676,16 +7676,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,
|
||||
boolean_type_node, se1.expr,
|
||||
logical_type_node, se1.expr,
|
||||
fold_convert (TREE_TYPE (se1.expr), se2.expr));
|
||||
|
||||
if (conda)
|
||||
tmp = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
|
||||
boolean_type_node, conda, tmp);
|
||||
logical_type_node, conda, tmp);
|
||||
|
||||
if (condb)
|
||||
tmp = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
|
||||
boolean_type_node, condb, tmp);
|
||||
logical_type_node, condb, tmp);
|
||||
|
||||
se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp);
|
||||
}
|
||||
|
|
@ -7811,7 +7811,7 @@ gfc_conv_intrinsic_trim (gfc_se * se, gfc_expr * expr)
|
|||
gfc_add_expr_to_block (&se->pre, tmp);
|
||||
|
||||
/* Free the temporary afterwards, if necessary. */
|
||||
cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
|
||||
len, build_int_cst (TREE_TYPE (len), 0));
|
||||
tmp = gfc_call_free (var);
|
||||
tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt (input_location));
|
||||
|
|
@ -7845,7 +7845,7 @@ gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr)
|
|||
ncopies_type = TREE_TYPE (ncopies);
|
||||
|
||||
/* Check that NCOPIES is not negative. */
|
||||
cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, ncopies,
|
||||
cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node, ncopies,
|
||||
build_int_cst (ncopies_type, 0));
|
||||
gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where,
|
||||
"Argument NCOPIES of REPEAT intrinsic is negative "
|
||||
|
|
@ -7855,7 +7855,7 @@ gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr)
|
|||
/* If the source length is zero, any non negative value of NCOPIES
|
||||
is valid, and nothing happens. */
|
||||
n = gfc_create_var (ncopies_type, "ncopies");
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, slen,
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, slen,
|
||||
build_int_cst (size_type_node, 0));
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR, ncopies_type, cond,
|
||||
build_int_cst (ncopies_type, 0), ncopies);
|
||||
|
|
@ -7872,13 +7872,13 @@ gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr)
|
|||
fold_convert (size_type_node, max), slen);
|
||||
largest = TYPE_PRECISION (size_type_node) > TYPE_PRECISION (ncopies_type)
|
||||
? size_type_node : ncopies_type;
|
||||
cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
|
||||
fold_convert (largest, ncopies),
|
||||
fold_convert (largest, max));
|
||||
tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, slen,
|
||||
tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, slen,
|
||||
build_int_cst (size_type_node, 0));
|
||||
cond = fold_build3_loc (input_location, COND_EXPR, boolean_type_node, tmp,
|
||||
boolean_false_node, cond);
|
||||
cond = fold_build3_loc (input_location, COND_EXPR, logical_type_node, tmp,
|
||||
logical_false_node, cond);
|
||||
gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where,
|
||||
"Argument NCOPIES of REPEAT intrinsic is too large");
|
||||
|
||||
|
|
@ -7901,7 +7901,7 @@ gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr)
|
|||
gfc_start_block (&body);
|
||||
|
||||
/* Exit the loop if count >= ncopies. */
|
||||
cond = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, count,
|
||||
cond = fold_build2_loc (input_location, GE_EXPR, logical_type_node, count,
|
||||
ncopies);
|
||||
tmp = build1_v (GOTO_EXPR, exit_label);
|
||||
TREE_USED (exit_label) = 1;
|
||||
|
|
@ -8050,7 +8050,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, boolean_type_node,
|
||||
se->expr = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
|
||||
arg1se.expr,
|
||||
fold_convert (TREE_TYPE (arg1se.expr),
|
||||
null_pointer_node));
|
||||
|
|
@ -8066,17 +8066,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, boolean_type_node,
|
||||
eq_expr = fold_build2_loc (input_location, EQ_EXPR, 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,
|
||||
boolean_type_node,
|
||||
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,
|
||||
boolean_type_node,
|
||||
logical_type_node,
|
||||
not_null_expr, eq_expr);
|
||||
}
|
||||
}
|
||||
|
|
@ -8301,11 +8301,11 @@ 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, boolean_type_node, arg,
|
||||
iszero = fold_build2_loc (input_location, EQ_EXPR, 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,
|
||||
boolean_type_node, isnormal, iszero);
|
||||
logical_type_node, isnormal, iszero);
|
||||
se->expr = fold_convert (gfc_typenode_for_spec (&expr->ts), se->expr);
|
||||
}
|
||||
|
||||
|
|
@ -8330,11 +8330,11 @@ 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, boolean_type_node,
|
||||
signbit = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
|
||||
signbit, integer_zero_node);
|
||||
|
||||
se->expr = fold_build2_loc (input_location, TRUTH_AND_EXPR,
|
||||
boolean_type_node, signbit,
|
||||
logical_type_node, signbit,
|
||||
fold_build1_loc (input_location, TRUTH_NOT_EXPR,
|
||||
TREE_TYPE(isnan), isnan));
|
||||
|
||||
|
|
@ -8480,7 +8480,7 @@ conv_intrinsic_ieee_copy_sign (gfc_se * se, gfc_expr * expr)
|
|||
sign = build_call_expr_loc (input_location,
|
||||
builtin_decl_explicit (BUILT_IN_SIGNBIT),
|
||||
1, args[1]);
|
||||
sign = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
|
||||
sign = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
|
||||
sign, integer_zero_node);
|
||||
|
||||
/* Create a value of one, with the right sign. */
|
||||
|
|
@ -10546,7 +10546,7 @@ conv_intrinsic_move_alloc (gfc_code *code)
|
|||
|
||||
tmp = gfc_conv_descriptor_data_get (to_se.expr);
|
||||
cond = fold_build2_loc (input_location, EQ_EXPR,
|
||||
boolean_type_node, tmp,
|
||||
logical_type_node, tmp,
|
||||
fold_convert (TREE_TYPE (tmp),
|
||||
null_pointer_node));
|
||||
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_all,
|
||||
|
|
|
|||
|
|
@ -581,7 +581,7 @@ set_parameter_value_chk (stmtblock_t *block, bool has_iostat, tree var,
|
|||
/* UNIT numbers should be greater than the min. */
|
||||
i = gfc_validate_kind (BT_INTEGER, 4, false);
|
||||
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,
|
||||
fold_convert (TREE_TYPE (se.expr), val));
|
||||
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,
|
|||
|
||||
/* UNIT numbers should be less than the max. */
|
||||
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,
|
||||
fold_convert (TREE_TYPE (se.expr), val));
|
||||
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,
|
|||
|
||||
/* UNIT numbers should be greater than zero. */
|
||||
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,
|
||||
fold_convert (TREE_TYPE (se.expr),
|
||||
integer_zero_node));
|
||||
/* UNIT numbers should be less than the max. */
|
||||
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,
|
||||
fold_convert (TREE_TYPE (se.expr), val));
|
||||
cond3 = build2_loc (input_location, TRUTH_OR_EXPR,
|
||||
boolean_type_node, cond1, cond2);
|
||||
logical_type_node, cond1, cond2);
|
||||
|
||||
gfc_start_block (&newblock);
|
||||
|
||||
|
|
@ -826,7 +826,7 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var,
|
|||
|
||||
gfc_conv_label_variable (&se, e);
|
||||
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));
|
||||
|
||||
msg = xasprintf ("Label assigned to variable '%s' (%%ld) is not a format "
|
||||
|
|
|
|||
|
|
@ -413,7 +413,7 @@ gfc_walk_alloc_comps (tree decl, tree dest, tree var,
|
|||
{
|
||||
tem = fold_convert (pvoid_type_node, tem);
|
||||
tem = fold_build2_loc (input_location, NE_EXPR,
|
||||
boolean_type_node, tem,
|
||||
logical_type_node, tem,
|
||||
null_pointer_node);
|
||||
then_b = build3_loc (input_location, COND_EXPR, void_type_node,
|
||||
tem, then_b,
|
||||
|
|
@ -540,7 +540,7 @@ gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer)
|
|||
GFC_DESCRIPTOR_TYPE_P (type)
|
||||
? gfc_conv_descriptor_data_get (outer) : outer);
|
||||
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);
|
||||
gfc_add_expr_to_block (&block,
|
||||
build3_loc (input_location, COND_EXPR,
|
||||
|
|
@ -646,7 +646,7 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
|
|||
build_zero_cst (TREE_TYPE (dest)));
|
||||
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);
|
||||
gfc_add_expr_to_block (&block,
|
||||
build3_loc (input_location, COND_EXPR,
|
||||
|
|
@ -699,7 +699,7 @@ gfc_omp_clause_assign_op (tree clause, tree dest, tree src)
|
|||
GFC_DESCRIPTOR_TYPE_P (type)
|
||||
? gfc_conv_descriptor_data_get (dest) : dest);
|
||||
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 = build3_loc (input_location, COND_EXPR, void_type_node, cond,
|
||||
then_b, build_empty_stmt (input_location));
|
||||
|
|
@ -739,7 +739,7 @@ gfc_omp_clause_assign_op (tree clause, tree dest, tree src)
|
|||
destptr = fold_convert (pvoid_type_node, 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);
|
||||
cond = nonalloc;
|
||||
if (GFC_DESCRIPTOR_TYPE_P (type))
|
||||
|
|
@ -755,11 +755,11 @@ gfc_omp_clause_assign_op (tree clause, tree dest, tree src)
|
|||
tem = fold_build2_loc (input_location, PLUS_EXPR,
|
||||
gfc_array_index_type, tem,
|
||||
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,
|
||||
rank));
|
||||
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)
|
|||
}
|
||||
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);
|
||||
gfc_add_expr_to_block (&block,
|
||||
build3_loc (input_location, COND_EXPR,
|
||||
|
|
@ -1028,7 +1028,7 @@ gfc_omp_clause_dtor (tree clause, tree decl)
|
|||
GFC_DESCRIPTOR_TYPE_P (type)
|
||||
? gfc_conv_descriptor_data_get (decl) : decl);
|
||||
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 = build3_loc (input_location, COND_EXPR, void_type_node, cond,
|
||||
then_b, build_empty_stmt (input_location));
|
||||
|
|
@ -1129,7 +1129,7 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p)
|
|||
tem = gfc_conv_descriptor_data_get (decl);
|
||||
tem = fold_convert (pvoid_type_node, tem);
|
||||
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,
|
||||
void_type_node, cond,
|
||||
then_b, else_b));
|
||||
|
|
@ -2155,7 +2155,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
|
|||
tem = gfc_conv_descriptor_data_get (decl);
|
||||
tem = fold_convert (pvoid_type_node, tem);
|
||||
cond = fold_build2_loc (input_location, NE_EXPR,
|
||||
boolean_type_node,
|
||||
logical_type_node,
|
||||
tem, null_pointer_node);
|
||||
gfc_add_expr_to_block (block,
|
||||
build3_loc (input_location,
|
||||
|
|
@ -3596,7 +3596,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
|
|||
/* The condition should not be folded. */
|
||||
TREE_VEC_ELT (cond, i) = build2_loc (input_location, simple > 0
|
||||
? 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,
|
||||
type, dovar, step);
|
||||
TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location,
|
||||
|
|
@ -3623,7 +3623,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
|
|||
build_int_cst (type, 0));
|
||||
/* The condition should not be folded. */
|
||||
TREE_VEC_ELT (cond, i) = build2_loc (input_location, LT_EXPR,
|
||||
boolean_type_node,
|
||||
logical_type_node,
|
||||
count, tmp);
|
||||
TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR,
|
||||
type, count,
|
||||
|
|
|
|||
|
|
@ -150,7 +150,7 @@ gfc_trans_goto (gfc_code * code)
|
|||
gfc_start_block (&se.pre);
|
||||
gfc_conv_label_variable (&se, code->expr1);
|
||||
tmp = GFC_DECL_STRING_LEN (se.expr);
|
||||
tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, tmp,
|
||||
tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp,
|
||||
build_int_cst (TREE_TYPE (tmp), -1));
|
||||
gfc_trans_runtime_check (true, false, tmp, &se.pre, &loc,
|
||||
"Assigned label is not a target label");
|
||||
|
|
@ -1106,7 +1106,7 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
|
|||
{
|
||||
tree cond;
|
||||
if (flag_coarray != GFC_FCOARRAY_LIB)
|
||||
cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
|
||||
images, build_int_cst (TREE_TYPE (images), 1));
|
||||
else
|
||||
{
|
||||
|
|
@ -1114,13 +1114,13 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
|
|||
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images,
|
||||
2, integer_zero_node,
|
||||
build_int_cst (integer_type_node, -1));
|
||||
cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
|
||||
images, tmp);
|
||||
cond2 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
|
||||
cond2 = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
|
||||
images,
|
||||
build_int_cst (TREE_TYPE (images), 1));
|
||||
cond = fold_build2_loc (input_location, TRUTH_OR_EXPR,
|
||||
boolean_type_node, cond, cond2);
|
||||
logical_type_node, cond, cond2);
|
||||
}
|
||||
gfc_trans_runtime_check (true, false, cond, &se.pre,
|
||||
&code->expr1->where, "Invalid image number "
|
||||
|
|
@ -1412,10 +1412,10 @@ gfc_trans_arithmetic_if (gfc_code * code)
|
|||
branch2 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label2));
|
||||
|
||||
if (code->label1->value != code->label3->value)
|
||||
tmp = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
|
||||
se.expr, zero);
|
||||
else
|
||||
tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
|
||||
se.expr, zero);
|
||||
|
||||
branch1 = fold_build3_loc (input_location, COND_EXPR, void_type_node,
|
||||
|
|
@ -1429,7 +1429,7 @@ gfc_trans_arithmetic_if (gfc_code * code)
|
|||
{
|
||||
/* if (cond <= 0) take branch1 else take branch2. */
|
||||
branch2 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label3));
|
||||
tmp = fold_build2_loc (input_location, LE_EXPR, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, LE_EXPR, logical_type_node,
|
||||
se.expr, zero);
|
||||
branch1 = fold_build3_loc (input_location, COND_EXPR, void_type_node,
|
||||
tmp, branch1, branch2);
|
||||
|
|
@ -1913,10 +1913,10 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
|
|||
|
||||
/* Evaluate the loop condition. */
|
||||
if (is_step_positive)
|
||||
cond = fold_build2_loc (loc, GT_EXPR, boolean_type_node, dovar,
|
||||
cond = fold_build2_loc (loc, GT_EXPR, logical_type_node, dovar,
|
||||
fold_convert (type, to));
|
||||
else
|
||||
cond = fold_build2_loc (loc, LT_EXPR, boolean_type_node, dovar,
|
||||
cond = fold_build2_loc (loc, LT_EXPR, logical_type_node, dovar,
|
||||
fold_convert (type, to));
|
||||
|
||||
cond = gfc_evaluate_now_loc (loc, cond, &body);
|
||||
|
|
@ -1935,7 +1935,7 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
|
|||
tree boundary = is_step_positive ? TYPE_MAX_VALUE (type)
|
||||
: TYPE_MIN_VALUE (type);
|
||||
|
||||
tmp = fold_build2_loc (loc, EQ_EXPR, boolean_type_node,
|
||||
tmp = fold_build2_loc (loc, EQ_EXPR, logical_type_node,
|
||||
dovar, boundary);
|
||||
gfc_trans_runtime_check (true, false, tmp, &body, &code->loc,
|
||||
"Loop iterates infinitely");
|
||||
|
|
@ -1955,7 +1955,7 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
|
|||
/* Check whether someone has modified the loop variable. */
|
||||
if (gfc_option.rtcheck & GFC_RTCHECK_DO)
|
||||
{
|
||||
tmp = fold_build2_loc (loc, NE_EXPR, boolean_type_node,
|
||||
tmp = fold_build2_loc (loc, NE_EXPR, logical_type_node,
|
||||
dovar, saved_dovar);
|
||||
gfc_trans_runtime_check (true, false, tmp, &body, &code->loc,
|
||||
"Loop variable has been modified");
|
||||
|
|
@ -2064,7 +2064,7 @@ gfc_trans_do (gfc_code * code, tree exit_cond)
|
|||
|
||||
if (gfc_option.rtcheck & GFC_RTCHECK_DO)
|
||||
{
|
||||
tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, step,
|
||||
tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, step,
|
||||
build_zero_cst (type));
|
||||
gfc_trans_runtime_check (true, false, tmp, &block, &code->loc,
|
||||
"DO step value is zero");
|
||||
|
|
@ -2131,7 +2131,7 @@ gfc_trans_do (gfc_code * code, tree exit_cond)
|
|||
|
||||
/* For a positive step, when to < from, exit, otherwise compute
|
||||
countm1 = ((unsigned)to - (unsigned)from) / (unsigned)step */
|
||||
tmp = fold_build2_loc (loc, LT_EXPR, boolean_type_node, to, from);
|
||||
tmp = fold_build2_loc (loc, LT_EXPR, logical_type_node, to, from);
|
||||
tmp2 = fold_build2_loc (loc, TRUNC_DIV_EXPR, utype,
|
||||
fold_build2_loc (loc, MINUS_EXPR, utype,
|
||||
tou, fromu),
|
||||
|
|
@ -2146,7 +2146,7 @@ gfc_trans_do (gfc_code * code, tree exit_cond)
|
|||
|
||||
/* For a negative step, when to > from, exit, otherwise compute
|
||||
countm1 = ((unsigned)from - (unsigned)to) / -(unsigned)step */
|
||||
tmp = fold_build2_loc (loc, GT_EXPR, boolean_type_node, to, from);
|
||||
tmp = fold_build2_loc (loc, GT_EXPR, logical_type_node, to, from);
|
||||
tmp2 = fold_build2_loc (loc, TRUNC_DIV_EXPR, utype,
|
||||
fold_build2_loc (loc, MINUS_EXPR, utype,
|
||||
fromu, tou),
|
||||
|
|
@ -2159,7 +2159,7 @@ gfc_trans_do (gfc_code * code, tree exit_cond)
|
|||
build1_loc (loc, GOTO_EXPR, void_type_node,
|
||||
exit_label), NULL_TREE));
|
||||
|
||||
tmp = fold_build2_loc (loc, LT_EXPR, boolean_type_node, step,
|
||||
tmp = fold_build2_loc (loc, LT_EXPR, logical_type_node, step,
|
||||
build_int_cst (TREE_TYPE (step), 0));
|
||||
tmp = fold_build3_loc (loc, COND_EXPR, void_type_node, tmp, neg, pos);
|
||||
|
||||
|
|
@ -2180,13 +2180,13 @@ gfc_trans_do (gfc_code * code, tree exit_cond)
|
|||
|
||||
/* We need a special check for empty loops:
|
||||
empty = (step > 0 ? to < from : to > from); */
|
||||
pos_step = fold_build2_loc (loc, GT_EXPR, boolean_type_node, step,
|
||||
pos_step = fold_build2_loc (loc, GT_EXPR, logical_type_node, step,
|
||||
build_zero_cst (type));
|
||||
tmp = fold_build3_loc (loc, COND_EXPR, boolean_type_node, pos_step,
|
||||
tmp = fold_build3_loc (loc, COND_EXPR, logical_type_node, pos_step,
|
||||
fold_build2_loc (loc, LT_EXPR,
|
||||
boolean_type_node, to, from),
|
||||
logical_type_node, to, from),
|
||||
fold_build2_loc (loc, GT_EXPR,
|
||||
boolean_type_node, to, from));
|
||||
logical_type_node, to, from));
|
||||
/* If the loop is empty, go directly to the exit label. */
|
||||
tmp = fold_build3_loc (loc, COND_EXPR, void_type_node, tmp,
|
||||
build1_v (GOTO_EXPR, exit_label),
|
||||
|
|
@ -2211,7 +2211,7 @@ gfc_trans_do (gfc_code * code, tree exit_cond)
|
|||
/* Check whether someone has modified the loop variable. */
|
||||
if (gfc_option.rtcheck & GFC_RTCHECK_DO)
|
||||
{
|
||||
tmp = fold_build2_loc (loc, NE_EXPR, boolean_type_node, dovar,
|
||||
tmp = fold_build2_loc (loc, NE_EXPR, logical_type_node, dovar,
|
||||
saved_dovar);
|
||||
gfc_trans_runtime_check (true, false, tmp, &body, &code->loc,
|
||||
"Loop variable has been modified");
|
||||
|
|
@ -2244,7 +2244,7 @@ gfc_trans_do (gfc_code * code, tree exit_cond)
|
|||
gfc_add_modify_loc (loc, &body, countm1, tmp);
|
||||
|
||||
/* End with the loop condition. Loop until countm1t == 0. */
|
||||
cond = fold_build2_loc (loc, EQ_EXPR, boolean_type_node, countm1t,
|
||||
cond = fold_build2_loc (loc, EQ_EXPR, logical_type_node, countm1t,
|
||||
build_int_cst (utype, 0));
|
||||
tmp = fold_build1_loc (loc, GOTO_EXPR, void_type_node, exit_label);
|
||||
tmp = fold_build3_loc (loc, COND_EXPR, void_type_node,
|
||||
|
|
@ -3398,7 +3398,7 @@ gfc_trans_forall_loop (forall_info *forall_tmp, tree body,
|
|||
gfc_init_block (&block);
|
||||
|
||||
/* The exit condition. */
|
||||
cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node,
|
||||
cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node,
|
||||
count, build_int_cst (TREE_TYPE (count), 0));
|
||||
if (forall_tmp->do_concurrent)
|
||||
cond = build2 (ANNOTATE_EXPR, TREE_TYPE (cond), cond,
|
||||
|
|
@ -5076,7 +5076,7 @@ gfc_trans_where_2 (gfc_code * code, tree mask, bool invert,
|
|||
&inner_size_body, block);
|
||||
|
||||
/* Check whether the size is negative. */
|
||||
cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, size,
|
||||
cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node, size,
|
||||
gfc_index_zero_node);
|
||||
size = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type,
|
||||
cond, gfc_index_zero_node, size);
|
||||
|
|
@ -6081,7 +6081,7 @@ gfc_trans_allocate (gfc_code * code)
|
|||
polymorphic and stores a _len dependent object,
|
||||
e.g., a string. */
|
||||
memsz = fold_build2_loc (input_location, GT_EXPR,
|
||||
boolean_type_node, expr3_len,
|
||||
logical_type_node, expr3_len,
|
||||
integer_zero_node);
|
||||
memsz = fold_build3_loc (input_location, COND_EXPR,
|
||||
TREE_TYPE (expr3_esize),
|
||||
|
|
@ -6214,7 +6214,7 @@ gfc_trans_allocate (gfc_code * code)
|
|||
{
|
||||
tmp = build1_v (GOTO_EXPR, label_errmsg);
|
||||
parm = fold_build2_loc (input_location, NE_EXPR,
|
||||
boolean_type_node, stat,
|
||||
logical_type_node, stat,
|
||||
build_int_cst (TREE_TYPE (stat), 0));
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
|
||||
gfc_unlikely (parm, PRED_FORTRAN_FAIL_ALLOC),
|
||||
|
|
@ -6433,7 +6433,7 @@ gfc_trans_allocate (gfc_code * code)
|
|||
gfc_default_character_kind);
|
||||
dlen = gfc_finish_block (&errmsg_block);
|
||||
|
||||
tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
|
||||
tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
|
||||
stat, build_int_cst (TREE_TYPE (stat), 0));
|
||||
|
||||
tmp = build3_v (COND_EXPR, tmp,
|
||||
|
|
@ -6671,7 +6671,7 @@ gfc_trans_deallocate (gfc_code *code)
|
|||
{
|
||||
tree cond;
|
||||
|
||||
cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, stat,
|
||||
cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, stat,
|
||||
build_int_cst (TREE_TYPE (stat), 0));
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
|
||||
gfc_unlikely (cond, PRED_FORTRAN_FAIL_ALLOC),
|
||||
|
|
@ -6711,7 +6711,7 @@ gfc_trans_deallocate (gfc_code *code)
|
|||
slen, errmsg_str, gfc_default_character_kind);
|
||||
tmp = gfc_finish_block (&errmsg_block);
|
||||
|
||||
cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, stat,
|
||||
cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, stat,
|
||||
build_int_cst (TREE_TYPE (stat), 0));
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
|
||||
gfc_unlikely (cond, PRED_FORTRAN_FAIL_ALLOC), tmp,
|
||||
|
|
|
|||
|
|
@ -60,6 +60,9 @@ tree ppvoid_type_node;
|
|||
tree pchar_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_float128_type_node = NULL_TREE;
|
||||
|
|
@ -976,6 +979,11 @@ gfc_init_types (void)
|
|||
wi::mask (n, UNSIGNED,
|
||||
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? */
|
||||
gfc_charlen_int_kind = 4;
|
||||
gfc_charlen_type_node = gfc_get_int_type (gfc_charlen_int_kind);
|
||||
|
|
@ -3228,11 +3236,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);
|
||||
info->data_location = build1 (INDIRECT_REF, ptr_type_node, t);
|
||||
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);
|
||||
else if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER
|
||||
|| 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);
|
||||
if ((GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK
|
||||
|| GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_CONT)
|
||||
|
|
|
|||
|
|
@ -33,6 +33,20 @@ extern GTY(()) tree pchar_type_node;
|
|||
extern GTY(()) tree gfc_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.
|
||||
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
|
||||
|
|
|
|||
|
|
@ -533,9 +533,9 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
|
|||
|
||||
if (once)
|
||||
{
|
||||
tmpvar = gfc_create_var (boolean_type_node, "print_warning");
|
||||
tmpvar = gfc_create_var (logical_type_node, "print_warning");
|
||||
TREE_STATIC (tmpvar) = 1;
|
||||
DECL_INITIAL (tmpvar) = boolean_true_node;
|
||||
DECL_INITIAL (tmpvar) = logical_true_node;
|
||||
gfc_add_expr_to_block (pblock, tmpvar);
|
||||
}
|
||||
|
||||
|
|
@ -554,7 +554,7 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
|
|||
va_end (ap);
|
||||
|
||||
if (once)
|
||||
gfc_add_modify (&block, tmpvar, boolean_false_node);
|
||||
gfc_add_modify (&block, tmpvar, logical_false_node);
|
||||
|
||||
body = gfc_finish_block (&block);
|
||||
|
||||
|
|
@ -607,7 +607,7 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size)
|
|||
if (gfc_option.rtcheck & GFC_RTCHECK_MEM)
|
||||
{
|
||||
null_result = fold_build2_loc (input_location, EQ_EXPR,
|
||||
boolean_type_node, res,
|
||||
logical_type_node, res,
|
||||
build_int_cst (pvoid_type_node, 0));
|
||||
msg = gfc_build_addr_expr (pchar_type_node,
|
||||
gfc_build_localized_cstring_const ("Memory allocation failed"));
|
||||
|
|
@ -693,7 +693,7 @@ gfc_allocate_using_malloc (stmtblock_t * block, tree pointer,
|
|||
}
|
||||
|
||||
error_cond = fold_build2_loc (input_location, EQ_EXPR,
|
||||
boolean_type_node, pointer,
|
||||
logical_type_node, pointer,
|
||||
build_int_cst (prvoid_type_node, 0));
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
|
||||
gfc_unlikely (error_cond, PRED_FORTRAN_FAIL_ALLOC),
|
||||
|
|
@ -795,7 +795,7 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size,
|
|||
|
||||
size = fold_convert (size_type_node, size);
|
||||
null_mem = gfc_unlikely (fold_build2_loc (input_location, NE_EXPR,
|
||||
boolean_type_node, mem,
|
||||
logical_type_node, mem,
|
||||
build_int_cst (type, 0)),
|
||||
PRED_FORTRAN_REALLOC);
|
||||
|
||||
|
|
@ -873,7 +873,7 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size,
|
|||
{
|
||||
TREE_USED (label_finish) = 1;
|
||||
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)));
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
|
||||
gfc_unlikely (cond, PRED_FORTRAN_FAIL_ALLOC),
|
||||
|
|
@ -1090,12 +1090,12 @@ gfc_add_comp_finalizer_call (stmtblock_t *block, tree decl, gfc_component *comp,
|
|||
{
|
||||
tmp = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (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),
|
||||
null_pointer_node));
|
||||
}
|
||||
else
|
||||
cond = boolean_true_node;
|
||||
cond = logical_true_node;
|
||||
|
||||
if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (array)))
|
||||
{
|
||||
|
|
@ -1111,12 +1111,12 @@ gfc_add_comp_finalizer_call (stmtblock_t *block, tree decl, gfc_component *comp,
|
|||
|
||||
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,
|
||||
fold_convert (TREE_TYPE (final_fndecl),
|
||||
null_pointer_node));
|
||||
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)))
|
||||
|
|
@ -1212,7 +1212,7 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2)
|
|||
gfc_init_se (&se, NULL);
|
||||
se.want_pointer = 1;
|
||||
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));
|
||||
|
||||
/* For CLASS(*) not only sym->_vtab->_final can be NULL
|
||||
|
|
@ -1230,11 +1230,11 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2)
|
|||
gfc_conv_expr (&se, 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,
|
||||
build_int_cst (TREE_TYPE (se.expr), 0));
|
||||
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,
|
||||
|
|
@ -1340,7 +1340,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
|
|||
else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (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));
|
||||
|
||||
/* When POINTER is NULL, we set STATUS to 1 if it's present, otherwise
|
||||
|
|
@ -1367,7 +1367,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
|
|||
tree cond2;
|
||||
|
||||
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));
|
||||
tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
|
||||
fold_build1_loc (input_location, INDIRECT_REF,
|
||||
|
|
@ -1400,7 +1400,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
|
|||
tree status_type = TREE_TYPE (TREE_TYPE (status));
|
||||
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));
|
||||
tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
|
||||
|
|
@ -1463,7 +1463,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
|
|||
|
||||
TREE_USED (label_finish) = 1;
|
||||
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)));
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
|
||||
gfc_unlikely (cond2, PRED_FORTRAN_REALLOC),
|
||||
|
|
@ -1499,7 +1499,7 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish,
|
|||
&& comp_ref)
|
||||
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));
|
||||
|
||||
/* When POINTER is NULL, we set STATUS to 1 if it's present, otherwise
|
||||
|
|
@ -1526,7 +1526,7 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish,
|
|||
tree status_type = TREE_TYPE (TREE_TYPE (status));
|
||||
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));
|
||||
tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
|
||||
fold_build1_loc (input_location, INDIRECT_REF,
|
||||
|
|
@ -1571,7 +1571,7 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish,
|
|||
tree status_type = TREE_TYPE (TREE_TYPE (status));
|
||||
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));
|
||||
tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
|
||||
|
|
@ -1621,7 +1621,7 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish,
|
|||
|
||||
TREE_USED (label_finish) = 1;
|
||||
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)));
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
|
||||
gfc_unlikely (cond2, PRED_FORTRAN_REALLOC),
|
||||
|
|
@ -1664,11 +1664,11 @@ gfc_call_realloc (stmtblock_t * block, tree mem, tree size)
|
|||
builtin_decl_explicit (BUILT_IN_REALLOC), 2,
|
||||
fold_convert (pvoid_type_node, mem), size);
|
||||
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));
|
||||
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));
|
||||
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);
|
||||
msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const
|
||||
("Allocation would exceed memory limit"));
|
||||
|
|
|
|||
|
|
@ -1,3 +1,9 @@
|
|||
2017-11-13 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-10 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gnat.dg/opt69.adb: New test.
|
||||
|
|
|
|||
|
|
@ -0,0 +1,13 @@
|
|||
! { 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
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
! { 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
|
||||
Loading…
Reference in New Issue