From: Richard Biener Date: Fri, 16 Oct 2020 08:32:26 +0000 (+0200) Subject: Refactor array descriptor field access X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=6d65ddca42f296b7e4413aac49497698415abce6;p=gcc.git Refactor array descriptor field access This refactors the array descriptor component access tree building to commonize code into new helpers to provide a single place to fix correctness issues with respect to TBAA. The only interesting part is the gfc_conv_descriptor_data_get change to drop broken special-casing of REFERENCE_TYPE desc which, when hit, would build invalid GENERIC trees, missing an INDIRECT_REF before subsetting the descriptor with a COMPONENT_REF. 2020-10-16 Richard Biener gcc/fortran/ChangeLog: * trans-array.c (gfc_get_descriptor_field): New helper. (gfc_conv_descriptor_data_get): Use it - drop strange REFERENCE_TYPE handling and make sure we don't trigger it. (gfc_conv_descriptor_data_addr): Use gfc_get_descriptor_field. (gfc_conv_descriptor_data_set): Likewise. (gfc_conv_descriptor_offset): Likewise. (gfc_conv_descriptor_dtype): Likewise. (gfc_conv_descriptor_span): Likewise. (gfc_get_descriptor_dimension): Likewise. (gfc_conv_descriptor_token): Likewise. (gfc_conv_descriptor_subfield): New helper. (gfc_conv_descriptor_stride): Use it. (gfc_conv_descriptor_lbound): Likewise. (gfc_conv_descriptor_ubound): Likewise. --- diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 998d4d4ed9b..b2c39aa32de 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -133,28 +133,31 @@ gfc_array_dataptr_type (tree desc) #define LBOUND_SUBFIELD 1 #define UBOUND_SUBFIELD 2 +static tree +gfc_get_descriptor_field (tree desc, unsigned field_idx) +{ + tree type = TREE_TYPE (desc); + gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); + + tree field = gfc_advance_chain (TYPE_FIELDS (type), field_idx); + gcc_assert (field != NULL_TREE); + + return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), + desc, field, NULL_TREE); +} + /* This provides READ-ONLY access to the data field. The field itself doesn't have the proper type. */ tree gfc_conv_descriptor_data_get (tree desc) { - tree field, type, t; - - type = TREE_TYPE (desc); + tree type = TREE_TYPE (desc); if (TREE_CODE (type) == REFERENCE_TYPE) - type = TREE_TYPE (type); + gcc_unreachable (); - gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); - - field = TYPE_FIELDS (type); - gcc_assert (DATA_FIELD == 0); - - t = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), desc, - field, NULL_TREE); - t = fold_convert (GFC_TYPE_ARRAY_DATAPTR_TYPE (type), t); - - return t; + tree field = gfc_get_descriptor_field (desc, DATA_FIELD); + return fold_convert (GFC_TYPE_ARRAY_DATAPTR_TYPE (type), field); } /* This provides WRITE access to the data field. @@ -168,17 +171,8 @@ gfc_conv_descriptor_data_get (tree desc) void gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value) { - tree field, type, t; - - type = TREE_TYPE (desc); - gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); - - field = TYPE_FIELDS (type); - gcc_assert (DATA_FIELD == 0); - - t = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), desc, - field, NULL_TREE); - gfc_add_modify (block, t, fold_convert (TREE_TYPE (field), value)); + tree field = gfc_get_descriptor_field (desc, DATA_FIELD); + gfc_add_modify (block, field, fold_convert (TREE_TYPE (field), value)); } @@ -188,33 +182,16 @@ gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value) tree gfc_conv_descriptor_data_addr (tree desc) { - tree field, type, t; - - type = TREE_TYPE (desc); - gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); - - field = TYPE_FIELDS (type); - gcc_assert (DATA_FIELD == 0); - - t = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), desc, - field, NULL_TREE); - return gfc_build_addr_expr (NULL_TREE, t); + tree field = gfc_get_descriptor_field (desc, DATA_FIELD); + return gfc_build_addr_expr (NULL_TREE, field); } static tree gfc_conv_descriptor_offset (tree desc) { - tree type; - tree field; - - type = TREE_TYPE (desc); - gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); - - field = gfc_advance_chain (TYPE_FIELDS (type), OFFSET_FIELD); - gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type); - - return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), - desc, field, NULL_TREE); + tree field = gfc_get_descriptor_field (desc, OFFSET_FIELD); + gcc_assert (TREE_TYPE (field) == gfc_array_index_type); + return field; } tree @@ -235,34 +212,17 @@ gfc_conv_descriptor_offset_set (stmtblock_t *block, tree desc, tree gfc_conv_descriptor_dtype (tree desc) { - tree field; - tree type; - - type = TREE_TYPE (desc); - gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); - - field = gfc_advance_chain (TYPE_FIELDS (type), DTYPE_FIELD); - gcc_assert (field != NULL_TREE - && TREE_TYPE (field) == get_dtype_type_node ()); - - return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), - desc, field, NULL_TREE); + tree field = gfc_get_descriptor_field (desc, DTYPE_FIELD); + gcc_assert (TREE_TYPE (field) == get_dtype_type_node ()); + return field; } static tree gfc_conv_descriptor_span (tree desc) { - tree type; - tree field; - - type = TREE_TYPE (desc); - gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); - - field = gfc_advance_chain (TYPE_FIELDS (type), SPAN_FIELD); - gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type); - - return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), - desc, field, NULL_TREE); + tree field = gfc_get_descriptor_field (desc, SPAN_FIELD); + gcc_assert (TREE_TYPE (field) == gfc_array_index_type); + return field; } tree @@ -328,22 +288,13 @@ gfc_conv_descriptor_attribute (tree desc) dtype, tmp, NULL_TREE); } - tree gfc_get_descriptor_dimension (tree desc) { - tree type, field; - - type = TREE_TYPE (desc); - gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); - - field = gfc_advance_chain (TYPE_FIELDS (type), DIMENSION_FIELD); - gcc_assert (field != NULL_TREE - && TREE_CODE (TREE_TYPE (field)) == ARRAY_TYPE - && TREE_CODE (TREE_TYPE (TREE_TYPE (field))) == RECORD_TYPE); - - return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), - desc, field, NULL_TREE); + tree field = gfc_get_descriptor_field (desc, DIMENSION_FIELD); + gcc_assert (TREE_CODE (TREE_TYPE (field)) == ARRAY_TYPE + && TREE_CODE (TREE_TYPE (TREE_TYPE (field))) == RECORD_TYPE); + return field; } @@ -361,38 +312,31 @@ gfc_conv_descriptor_dimension (tree desc, tree dim) tree gfc_conv_descriptor_token (tree desc) { - tree type; - tree field; - - type = TREE_TYPE (desc); - gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); gcc_assert (flag_coarray == GFC_FCOARRAY_LIB); - field = gfc_advance_chain (TYPE_FIELDS (type), CAF_TOKEN_FIELD); - + tree field = gfc_get_descriptor_field (desc, CAF_TOKEN_FIELD); /* Should be a restricted pointer - except in the finalization wrapper. */ - gcc_assert (field != NULL_TREE - && (TREE_TYPE (field) == prvoid_type_node - || TREE_TYPE (field) == pvoid_type_node)); + gcc_assert (TREE_TYPE (field) == prvoid_type_node + || TREE_TYPE (field) == pvoid_type_node); + return field; +} + +static tree +gfc_conv_descriptor_subfield (tree desc, tree dim, unsigned field_idx) +{ + tree tmp = gfc_conv_descriptor_dimension (desc, dim); + tree field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)), field_idx); + gcc_assert (field != NULL_TREE); return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), - desc, field, NULL_TREE); + tmp, field, NULL_TREE); } - static tree gfc_conv_descriptor_stride (tree desc, tree dim) { - tree tmp; - tree field; - - tmp = gfc_conv_descriptor_dimension (desc, dim); - field = TYPE_FIELDS (TREE_TYPE (tmp)); - field = gfc_advance_chain (field, STRIDE_SUBFIELD); - gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type); - - tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), - tmp, field, NULL_TREE); - return tmp; + tree field = gfc_conv_descriptor_subfield (desc, dim, STRIDE_SUBFIELD); + gcc_assert (TREE_TYPE (field) == gfc_array_index_type); + return field; } tree @@ -421,17 +365,9 @@ gfc_conv_descriptor_stride_set (stmtblock_t *block, tree desc, static tree gfc_conv_descriptor_lbound (tree desc, tree dim) { - tree tmp; - tree field; - - tmp = gfc_conv_descriptor_dimension (desc, dim); - field = TYPE_FIELDS (TREE_TYPE (tmp)); - field = gfc_advance_chain (field, LBOUND_SUBFIELD); - gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type); - - tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), - tmp, field, NULL_TREE); - return tmp; + tree field = gfc_conv_descriptor_subfield (desc, dim, LBOUND_SUBFIELD); + gcc_assert (TREE_TYPE (field) == gfc_array_index_type); + return field; } tree @@ -451,17 +387,9 @@ gfc_conv_descriptor_lbound_set (stmtblock_t *block, tree desc, static tree gfc_conv_descriptor_ubound (tree desc, tree dim) { - tree tmp; - tree field; - - tmp = gfc_conv_descriptor_dimension (desc, dim); - field = TYPE_FIELDS (TREE_TYPE (tmp)); - field = gfc_advance_chain (field, UBOUND_SUBFIELD); - gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type); - - tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), - tmp, field, NULL_TREE); - return tmp; + tree field = gfc_conv_descriptor_subfield (desc, dim, UBOUND_SUBFIELD); + gcc_assert (TREE_TYPE (field) == gfc_array_index_type); + return field; } tree