From 711a520c401ef55219e499a9406085ef25503dd4 Mon Sep 17 00:00:00 2001 From: vehre Date: Sat, 4 Nov 2017 14:35:45 +0000 Subject: gcc/fortran/ChangeLog: 2017-11-04 Andre Vehreschild * trans-expr.c (gfc_trans_assignment_1): Character kind conversion may create a loop variant temporary, too. * trans-intrinsic.c (conv_caf_send): Treat char arrays as arrays and not as scalars. * trans.c (get_array_span): Take the character kind into account when doing pointer arithmetic. gcc/testsuite/ChangeLog: 2017-11-04 Andre Vehreschild * gfortran.dg/coarray/send_char_array_1.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@254407 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans.c | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/trans.c') diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 53bc4285c78..411530884de 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -320,8 +320,12 @@ get_array_span (tree type, tree decl) || DECL_CONTEXT (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) == DECL_CONTEXT (decl))) { - span = TYPE_MAX_VALUE (TYPE_DOMAIN (type)); - span = fold_convert (gfc_array_index_type, span); + span = fold_convert (gfc_array_index_type, + TYPE_MAX_VALUE (TYPE_DOMAIN (type))); + span = fold_build2 (MULT_EXPR, gfc_array_index_type, + fold_convert (gfc_array_index_type, + TYPE_SIZE_UNIT (TREE_TYPE (type))), + span); } /* Likewise for class array or pointer array references. */ else if (TREE_CODE (decl) == FIELD_DECL -- cgit v1.2.1 From 4c796f543f500c25dcfa731d4f1a4f27b5bf050c Mon Sep 17 00:00:00 2001 From: jb Date: Wed, 8 Nov 2017 11:51:00 +0000 Subject: PR 82869 Introduce logical_type_node and use it Earlier GFortran used to redefine boolean_type_node, which in the rest of the compiler means the C/C++ _Bool/bool type, to the Fortran default logical type. When this redefinition was removed, a few issues surfaced. Namely, 1) PR 82869, where we created a boolean tmp variable, and passed it to the runtime library as a Fortran logical variable of a different size. 2) Fortran specifies that logical operations should be done with the default logical kind, not in any other kind. 3) Using 8-bit variables have some issues, such as - on x86, partial register stalls and length prefix changes. - s390 has a compare with immediate and jump instruction which works with 32-bit but not 8-bit quantities. This patch addresses these issues by introducing a type logical_type_node which is a Fortran LOGICAL variable of default kind. It is then used in places were the Fortran standard mandates, as well as for compiler generated temporary variables. For x86-64, using the Polyhedron benchmark suite, no performance or code size difference worth mentioning was observed. Regtested on x86_64-pc-linux-gnu. gcc/fortran/ChangeLog: 2017-11-08 Janne Blomqvist PR 82869 * convert.c (truthvalue_conversion): Use logical_type_node. * trans-array.c (gfc_trans_allocate_array_storage): Likewise. (gfc_trans_create_temp_array): Likewise. (gfc_trans_array_ctor_element): Likewise. (gfc_trans_array_constructor_value): Likewise. (trans_array_constructor): Likewise. (trans_array_bound_check): Likewise. (gfc_conv_array_ref): Likewise. (gfc_trans_scalarized_loop_end): Likewise. (gfc_conv_array_extent_dim): Likewise. (gfc_array_init_size): Likewise. (gfc_array_allocate): Likewise. (gfc_trans_array_bounds): Likewise. (gfc_trans_dummy_array_bias): Likewise. (gfc_conv_array_parameter): Likewise. (duplicate_allocatable): Likewise. (duplicate_allocatable_coarray): Likewise. (structure_alloc_comps): Likewise (get_std_lbound): Likewise (gfc_alloc_allocatable_for_assignment): Likewise * trans-decl.c (add_argument_checking): Likewise (gfc_generate_function_code): Likewise * trans-expr.c (gfc_copy_class_to_class): Likewise (gfc_trans_class_array_init_assign): Likewise (gfc_trans_class_init_assign): Likewise (gfc_conv_expr_present): Likewise (gfc_conv_substring): Likewise (gfc_conv_cst_int_power): Likewise (gfc_conv_expr_op): Likewise (gfc_conv_procedure_call): Likewise (fill_with_spaces): Likewise (gfc_trans_string_copy): Likewise (gfc_trans_alloc_subarray_assign): Likewise (gfc_trans_pointer_assignment): Likewise (gfc_trans_scalar_assign): Likewise (fcncall_realloc_result): Likewise (alloc_scalar_allocatable_for_assignment): Likewise (trans_class_assignment): Likewise (gfc_trans_assignment_1): Likewise * trans-intrinsic.c (build_fixbound_expr): Likewise (gfc_conv_intrinsic_aint): Likewise (gfc_trans_same_strlen_check): Likewise (conv_caf_send): Likewise (trans_this_image): Likewise (conv_intrinsic_image_status): Likewise (trans_image_index): Likewise (gfc_conv_intrinsic_bound): Likewise (conv_intrinsic_cobound): Likewise (gfc_conv_intrinsic_mod): Likewise (gfc_conv_intrinsic_dshift): Likewise (gfc_conv_intrinsic_dim): Likewise (gfc_conv_intrinsic_sign): Likewise (gfc_conv_intrinsic_ctime): Likewise (gfc_conv_intrinsic_fdate): Likewise (gfc_conv_intrinsic_ttynam): Likewise (gfc_conv_intrinsic_minmax): Likewise (gfc_conv_intrinsic_minmax_char): Likewise (gfc_conv_intrinsic_anyall): Likewise (gfc_conv_intrinsic_arith): Likewise (gfc_conv_intrinsic_minmaxloc): Likewise (gfc_conv_intrinsic_minmaxval): Likewise (gfc_conv_intrinsic_btest): Likewise (gfc_conv_intrinsic_bitcomp): Likewise (gfc_conv_intrinsic_shift): Likewise (gfc_conv_intrinsic_ishft): Likewise (gfc_conv_intrinsic_ishftc): Likewise (gfc_conv_intrinsic_leadz): Likewise (gfc_conv_intrinsic_trailz): Likewise (gfc_conv_intrinsic_mask): Likewise (gfc_conv_intrinsic_spacing): Likewise (gfc_conv_intrinsic_rrspacing): Likewise (gfc_conv_intrinsic_size): Likewise (gfc_conv_intrinsic_sizeof): Likewise (gfc_conv_intrinsic_transfer): Likewise (gfc_conv_allocated): Likewise (gfc_conv_associated): Likewise (gfc_conv_same_type_as): Likewise (gfc_conv_intrinsic_trim): Likewise (gfc_conv_intrinsic_repeat): Likewise (conv_isocbinding_function): Likewise (conv_intrinsic_ieee_is_normal): Likewise (conv_intrinsic_ieee_is_negative): Likewise (conv_intrinsic_ieee_copy_sign): Likewise (conv_intrinsic_move_alloc): Likewise * trans-io.c (set_parameter_value_chk): Likewise (set_parameter_value_inquire): Likewise (set_string): Likewise * trans-openmp.c (gfc_walk_alloc_comps): Likewise (gfc_omp_clause_default_ctor): Likewise (gfc_omp_clause_copy_ctor): Likewise (gfc_omp_clause_assign_op): Likewise (gfc_omp_clause_dtor): Likewise (gfc_omp_finish_clause): Likewise (gfc_trans_omp_clauses): Likewise (gfc_trans_omp_do): Likewise * trans-stmt.c (gfc_trans_goto): Likewise (gfc_trans_sync): Likewise (gfc_trans_arithmetic_if): Likewise (gfc_trans_simple_do): Likewise (gfc_trans_do): Likewise (gfc_trans_forall_loop): Likewise (gfc_trans_where_2): Likewise (gfc_trans_allocate): Likewise (gfc_trans_deallocate): Likewise * trans-types.c (gfc_init_types): Initialize logical_type_node and its true/false trees. (gfc_get_array_descr_info): Use logical_type_node. * trans-types.h (logical_type_node): New tree. (logical_true_node): Likewise. (logical_false_node): Likewise. * trans.c (gfc_trans_runtime_check): Use logical_type_node. (gfc_call_malloc): Likewise (gfc_allocate_using_malloc): Likewise (gfc_allocate_allocatable): Likewise (gfc_add_comp_finalizer_call): Likewise (gfc_add_finalizer_call): Likewise (gfc_deallocate_with_status): Likewise (gfc_deallocate_scalar_with_status): Likewise (gfc_call_realloc): Likewise gcc/testsuite/ChangeLog: 2017-11-08 Janne Blomqvist PR 82869 * gfortran.dg/logical_temp_io.f90: New test. * gfortran.dg/logical_temp_io_kind8.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@254526 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans.c | 50 +++++++++++++++++++++++++------------------------- 1 file changed, 25 insertions(+), 25 deletions(-) (limited to 'gcc/fortran/trans.c') diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 411530884de..8c1733448f4 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -537,9 +537,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); } @@ -558,7 +558,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); @@ -611,7 +611,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")); @@ -697,7 +697,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), @@ -799,7 +799,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); @@ -877,7 +877,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), @@ -1094,12 +1094,12 @@ gfc_add_comp_finalizer_call (stmtblock_t *block, tree decl, gfc_component *comp, { tmp = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (array)) ? 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))) { @@ -1115,12 +1115,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))) @@ -1216,7 +1216,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 @@ -1234,11 +1234,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, @@ -1344,7 +1344,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 @@ -1371,7 +1371,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, @@ -1404,7 +1404,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, @@ -1467,7 +1467,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), @@ -1503,7 +1503,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 @@ -1530,7 +1530,7 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish, tree status_type = TREE_TYPE (TREE_TYPE (status)); tree 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, @@ -1575,7 +1575,7 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish, tree status_type = TREE_TYPE (TREE_TYPE (status)); tree 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, @@ -1625,7 +1625,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), @@ -1668,11 +1668,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")); -- cgit v1.2.1