[gcc(refs/users/mikael/heads/refactor_descriptor_v291 .01)] Déplacement gfc_array_init_count -> gf c_descriptor_init_count
Mikael Morin via Gcc-cvs <[email protected]>
| Newsgroups | gmane.comp.gcc.cvs |
|---|---|
| Message-ID | <[email protected]> |
https://gcc.gnu.org/g:d4808dfbde09e43dc841bbd82b211177e07151c5 commit d4808dfbde09e43dc841bbd82b211177e07151c5 Author: Mikael Morin <[email protected]> Date: Thu Jul 31 14:41:23 2025 +0200 Déplacement gfc_array_init_count -> gfc_descriptor_init_count Déplacement gfc_grow_array Suppression gfc_grow_array en doublon Suppression gfc_descriptor_init_count en doublon Suppression déclaration gfc_grow_array en doublon Diff: --- gcc/fortran/trans-array.cc | 304 ++-------------------------------------- gcc/fortran/trans-descriptor.cc | 287 +++++++++++++++++++++++++++++++++++++ gcc/fortran/trans-descriptor.h | 5 + 3 files changed, 301 insertions(+), 295 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 95dcdef8a50d..cbd270305828 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -6077,292 +6077,6 @@ get_array_memory_size (tree element_size, tree elements_count, } -/* Fills in an array descriptor, and returns the size of the array. - The size will be a simple_val, ie a variable or a constant. Also - calculates the offset of the base. The pointer argument overflow, - which should be of integer type, will increase in value if overflow - occurs during the size calculation. Returns the size of the array. - { - stride = 1; - offset = 0; - for (n = 0; n < rank; n++) - { - a.lbound[n] = specified_lower_bound; - offset = offset + a.lbond[n] * stride; - size = 1 - lbound; - a.ubound[n] = specified_upper_bound; - a.stride[n] = stride; - size = size >= 0 ? ubound + size : 0; //size = ubound + 1 - lbound - overflow += size == 0 ? 0: (MAX/size < stride ? 1: 0); - stride = stride * size; - } - for (n = rank; n < rank+corank; n++) - (Set lcobound/ucobound as above.) - element_size = sizeof (array element); - if (!rank) - return element_size - stride = (size_t) stride; - overflow += element_size == 0 ? 0: (MAX/element_size < stride ? 1: 0); - stride = stride * element_size; - return (stride); - } */ -/*GCC ARRAYS*/ - -static tree -gfc_array_init_count (tree descriptor, int rank, int corank, gfc_expr ** lower, - gfc_expr ** upper, stmtblock_t * pblock, - stmtblock_t * descriptor_block, tree * overflow, - tree expr3_elem_size, gfc_expr *expr3, tree expr3_desc, - bool e3_has_nodescriptor, gfc_expr *expr, - tree element_size, bool explicit_ts, - tree *empty_array_cond) -{ - tree type; - tree tmp; - tree size; - tree offset; - tree stride; - tree cond; - gfc_expr *ubound; - gfc_se se; - int n; - - type = TREE_TYPE (descriptor); - - stride = gfc_index_one_node; - offset = gfc_index_zero_node; - - /* Set the dtype before the alloc, because registration of coarrays needs - it initialized. */ - if (expr->ts.type == BT_CHARACTER - && expr->ts.deferred - && VAR_P (expr->ts.u.cl->backend_decl)) - { - type = gfc_typenode_for_spec (&expr->ts); - gfc_conv_descriptor_dtype_set (pblock, descriptor, - gfc_get_dtype_rank_type (rank, type)); - } - else if (expr->ts.type == BT_CHARACTER - && expr->ts.deferred - && TREE_CODE (descriptor) == COMPONENT_REF) - { - /* Deferred character components have their string length tucked away - in a hidden field of the derived type. Obtain that and use it to - set the dtype. The charlen backend decl is zero because the field - type is zero length. */ - gfc_ref *ref; - tmp = NULL_TREE; - for (ref = expr->ref; ref; ref = ref->next) - if (ref->type == REF_COMPONENT - && gfc_deferred_strlen (ref->u.c.component, &tmp)) - break; - gcc_assert (tmp != NULL_TREE); - tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp), - TREE_OPERAND (descriptor, 0), tmp, NULL_TREE); - tmp = fold_convert (gfc_charlen_type_node, tmp); - type = gfc_get_character_type_len (expr->ts.kind, tmp); - gfc_conv_descriptor_dtype_set (pblock, descriptor, - gfc_get_dtype_rank_type (rank, type)); - } - else if (expr3_desc && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (expr3_desc))) - gfc_conv_descriptor_dtype_set (pblock, descriptor, - gfc_conv_descriptor_dtype_get (expr3_desc)); - else if (expr->ts.type == BT_CLASS && !explicit_ts - && expr3 && expr3->ts.type != BT_CLASS - && expr3_elem_size != NULL_TREE && expr3_desc == NULL_TREE) - { - gfc_conv_descriptor_dtype_set (pblock, descriptor, gfc_get_dtype (type)); - gfc_conv_descriptor_elem_len_set (pblock, descriptor, expr3_elem_size); - } - else - gfc_conv_descriptor_dtype_set (pblock, descriptor, gfc_get_dtype (type)); - - tree empty_cond = logical_false_node; - - for (n = 0; n < rank; n++) - { - tree conv_lbound; - tree conv_ubound; - - /* We have 3 possibilities for determining the size of the array: - lower == NULL => lbound = 1, ubound = upper[n] - upper[n] = NULL => lbound = 1, ubound = lower[n] - upper[n] != NULL => lbound = lower[n], ubound = upper[n] */ - ubound = upper[n]; - - /* Set lower bound. */ - gfc_init_se (&se, NULL); - if (expr3_desc != NULL_TREE) - { - if (e3_has_nodescriptor) - /* The lbound of nondescriptor arrays like array constructors, - nonallocatable/nonpointer function results/variables, - start at zero, but when allocating it, the standard expects - the array to start at one. */ - se.expr = gfc_index_one_node; - else - se.expr = gfc_conv_descriptor_lbound_get (expr3_desc, - gfc_rank_cst[n]); - } - else if (lower == NULL) - se.expr = gfc_index_one_node; - else - { - gcc_assert (lower[n]); - if (ubound) - { - gfc_conv_expr_type (&se, lower[n], gfc_array_index_type); - gfc_add_block_to_block (pblock, &se.pre); - } - else - { - se.expr = gfc_index_one_node; - ubound = lower[n]; - } - } - gfc_conv_descriptor_lbound_set (descriptor_block, descriptor, - gfc_rank_cst[n], se.expr); - conv_lbound = se.expr; - - /* Work out the offset for this component. */ - tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - se.expr, stride); - offset = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, offset, tmp); - - /* Set upper bound. */ - gfc_init_se (&se, NULL); - if (expr3_desc != NULL_TREE) - { - if (e3_has_nodescriptor) - { - /* The lbound of nondescriptor arrays like array constructors, - nonallocatable/nonpointer function results/variables, - start at zero, but when allocating it, the standard expects - the array to start at one. Therefore fix the upper bound to be - (desc.ubound - desc.lbound) + 1. */ - tmp = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, - gfc_conv_descriptor_ubound_get ( - expr3_desc, gfc_rank_cst[n]), - gfc_conv_descriptor_lbound_get ( - expr3_desc, gfc_rank_cst[n])); - tmp = fold_build2_loc (input_location, PLUS_EXPR, - gfc_array_index_type, tmp, - gfc_index_one_node); - se.expr = gfc_evaluate_now (tmp, pblock); - } - else - se.expr = gfc_conv_descriptor_ubound_get (expr3_desc, - gfc_rank_cst[n]); - } - else - { - gcc_assert (ubound); - gfc_conv_expr_type (&se, ubound, gfc_array_index_type); - gfc_add_block_to_block (pblock, &se.pre); - if (ubound->expr_type == EXPR_FUNCTION) - se.expr = gfc_evaluate_now (se.expr, pblock); - } - gfc_conv_descriptor_ubound_set (descriptor_block, descriptor, - gfc_rank_cst[n], se.expr); - conv_ubound = se.expr; - - /* Store the stride. */ - gfc_conv_descriptor_stride_set (descriptor_block, descriptor, - gfc_rank_cst[n], stride); - - /* Calculate size and check whether extent is negative. */ - size = gfc_conv_array_extent_dim (conv_lbound, conv_ubound, &empty_cond); - size = gfc_evaluate_now (size, pblock); - - /* Check whether multiplying the stride by the number of - elements in this dimension would overflow. We must also check - whether the current dimension has zero size in order to avoid - division by zero. - */ - tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR, - gfc_array_index_type, - fold_convert (gfc_array_index_type, - TYPE_MAX_VALUE (gfc_array_index_type)), - size); - cond = gfc_unlikely (fold_build2_loc (input_location, LT_EXPR, - 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, - logical_type_node, size, - gfc_index_zero_node), - PRED_FORTRAN_SIZE_ZERO); - tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond, - integer_zero_node, tmp); - tmp = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node, - *overflow, tmp); - *overflow = gfc_evaluate_now (tmp, pblock); - - /* Multiply the stride by the number of elements in this dimension. */ - stride = fold_build2_loc (input_location, MULT_EXPR, - gfc_array_index_type, stride, size); - stride = gfc_evaluate_now (stride, pblock); - } - - *empty_array_cond = empty_cond; - - for (n = rank; n < rank + corank; n++) - { - ubound = upper[n]; - - /* Set lower bound. */ - gfc_init_se (&se, NULL); - if (lower == NULL || lower[n] == NULL) - { - gcc_assert (n == rank + corank - 1); - se.expr = gfc_index_one_node; - } - else - { - if (ubound || n == rank + corank - 1) - { - gfc_conv_expr_type (&se, lower[n], gfc_array_index_type); - gfc_add_block_to_block (pblock, &se.pre); - } - else - { - se.expr = gfc_index_one_node; - ubound = lower[n]; - } - } - gfc_conv_descriptor_lbound_set (descriptor_block, descriptor, - gfc_rank_cst[n], se.expr); - - if (n < rank + corank - 1) - { - gfc_init_se (&se, NULL); - gcc_assert (ubound); - gfc_conv_expr_type (&se, ubound, gfc_array_index_type); - gfc_add_block_to_block (pblock, &se.pre); - gfc_conv_descriptor_ubound_set (descriptor_block, descriptor, - gfc_rank_cst[n], se.expr); - } - } - - /* The stride is the number of elements in the array, so multiply by the - size of an element to get the total size. */ - - if (rank == 0) - return gfc_index_one_node; - - /* Update the array descriptor with the offset and the span. */ - offset = gfc_evaluate_now (offset, pblock); - gfc_conv_descriptor_offset_set (descriptor_block, descriptor, offset); - tmp = fold_convert (gfc_array_index_type, element_size); - gfc_conv_descriptor_span_set (descriptor_block, descriptor, tmp); - - return stride; -} - - /* Retrieve the last ref from the chain. This routine is specific to gfc_array_allocate ()'s needs. */ @@ -6525,15 +6239,15 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, pointer components in derived types. */ tree empty_array_cond; gfc_init_block (&set_descriptor_block); - tree count = gfc_array_init_count (se->expr, - alloc_w_e3_arr_spec ? expr->rank - : ref->u.ar.as->rank, - coarray ? ref->u.ar.as->corank : 0, - lower, upper, &se->pre, - &set_descriptor_block, &overflow, - expr3_elem_size, expr3, e3_arr_desc, - e3_has_nodescriptor, expr, element_size, - explicit_ts, &empty_array_cond); + int rank = alloc_w_e3_arr_spec ? expr->rank : ref->u.ar.as->rank; + tree count = gfc_descriptor_init_count (se->expr, rank, + coarray ? ref->u.ar.as->corank : 0, + lower, upper, &se->pre, + &set_descriptor_block, &overflow, + expr3_elem_size, expr3, e3_arr_desc, + e3_has_nodescriptor, expr, + element_size, explicit_ts, + &empty_array_cond); tree size = get_array_memory_size (element_size, count, empty_array_cond, &se->pre, &overflow); diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc index 1c45c88b665e..38180990fd9c 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -2645,3 +2645,290 @@ gfc_set_pdt_array_descriptor (stmtblock_t *block, tree descr, return size; } + + +/* Fills in an array descriptor, and returns the size of the array. + The size will be a simple_val, ie a variable or a constant. Also + calculates the offset of the base. The pointer argument overflow, + which should be of integer type, will increase in value if overflow + occurs during the size calculation. Returns the size of the array. + { + stride = 1; + offset = 0; + for (n = 0; n < rank; n++) + { + a.lbound[n] = specified_lower_bound; + offset = offset + a.lbond[n] * stride; + size = 1 - lbound; + a.ubound[n] = specified_upper_bound; + a.stride[n] = stride; + size = size >= 0 ? ubound + size : 0; //size = ubound + 1 - lbound + overflow += size == 0 ? 0: (MAX/size < stride ? 1: 0); + stride = stride * size; + } + for (n = rank; n < rank+corank; n++) + (Set lcobound/ucobound as above.) + element_size = sizeof (array element); + if (!rank) + return element_size + stride = (size_t) stride; + overflow += element_size == 0 ? 0: (MAX/element_size < stride ? 1: 0); + stride = stride * element_size; + return (stride); + } */ +/*GCC ARRAYS*/ + +tree +gfc_descriptor_init_count (tree descriptor, int rank, int corank, + gfc_expr ** lower, gfc_expr ** upper, + stmtblock_t * pblock, stmtblock_t * descriptor_block, + tree * overflow, tree expr3_elem_size, + gfc_expr *expr3, tree expr3_desc, + bool e3_has_nodescriptor, gfc_expr *expr, + tree element_size, bool explicit_ts, + tree *empty_array_cond) +{ + tree type; + tree tmp; + tree size; + tree offset; + tree stride; + tree cond; + gfc_expr *ubound; + gfc_se se; + int n; + + type = TREE_TYPE (descriptor); + + stride = gfc_index_one_node; + offset = gfc_index_zero_node; + + /* Set the dtype before the alloc, because registration of coarrays needs + it initialized. */ + if (expr->ts.type == BT_CHARACTER + && expr->ts.deferred + && VAR_P (expr->ts.u.cl->backend_decl)) + { + type = gfc_typenode_for_spec (&expr->ts); + gfc_conv_descriptor_dtype_set (pblock, descriptor, + gfc_get_dtype_rank_type (rank, type)); + } + else if (expr->ts.type == BT_CHARACTER + && expr->ts.deferred + && TREE_CODE (descriptor) == COMPONENT_REF) + { + /* Deferred character components have their string length tucked away + in a hidden field of the derived type. Obtain that and use it to + set the dtype. The charlen backend decl is zero because the field + type is zero length. */ + gfc_ref *ref; + tmp = NULL_TREE; + for (ref = expr->ref; ref; ref = ref->next) + if (ref->type == REF_COMPONENT + && gfc_deferred_strlen (ref->u.c.component, &tmp)) + break; + gcc_assert (tmp != NULL_TREE); + tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp), + TREE_OPERAND (descriptor, 0), tmp, NULL_TREE); + tmp = fold_convert (gfc_charlen_type_node, tmp); + type = gfc_get_character_type_len (expr->ts.kind, tmp); + gfc_conv_descriptor_dtype_set (pblock, descriptor, + gfc_get_dtype_rank_type (rank, type)); + } + else if (expr3_desc && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (expr3_desc))) + gfc_conv_descriptor_dtype_set (pblock, descriptor, + gfc_conv_descriptor_dtype_get (expr3_desc)); + else if (expr->ts.type == BT_CLASS && !explicit_ts + && expr3 && expr3->ts.type != BT_CLASS + && expr3_elem_size != NULL_TREE && expr3_desc == NULL_TREE) + { + gfc_conv_descriptor_dtype_set (pblock, descriptor, gfc_get_dtype (type)); + gfc_conv_descriptor_elem_len_set (pblock, descriptor, expr3_elem_size); + } + else + gfc_conv_descriptor_dtype_set (pblock, descriptor, gfc_get_dtype (type)); + + tree empty_cond = logical_false_node; + + for (n = 0; n < rank; n++) + { + tree conv_lbound; + tree conv_ubound; + + /* We have 3 possibilities for determining the size of the array: + lower == NULL => lbound = 1, ubound = upper[n] + upper[n] = NULL => lbound = 1, ubound = lower[n] + upper[n] != NULL => lbound = lower[n], ubound = upper[n] */ + ubound = upper[n]; + + /* Set lower bound. */ + gfc_init_se (&se, NULL); + if (expr3_desc != NULL_TREE) + { + if (e3_has_nodescriptor) + /* The lbound of nondescriptor arrays like array constructors, + nonallocatable/nonpointer function results/variables, + start at zero, but when allocating it, the standard expects + the array to start at one. */ + se.expr = gfc_index_one_node; + else + se.expr = gfc_conv_descriptor_lbound_get (expr3_desc, + gfc_rank_cst[n]); + } + else if (lower == NULL) + se.expr = gfc_index_one_node; + else + { + gcc_assert (lower[n]); + if (ubound) + { + gfc_conv_expr_type (&se, lower[n], gfc_array_index_type); + gfc_add_block_to_block (pblock, &se.pre); + } + else + { + se.expr = gfc_index_one_node; + ubound = lower[n]; + } + } + gfc_conv_descriptor_lbound_set (descriptor_block, descriptor, + gfc_rank_cst[n], se.expr); + conv_lbound = se.expr; + + /* Work out the offset for this component. */ + tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, + se.expr, stride); + offset = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, offset, tmp); + + /* Set upper bound. */ + gfc_init_se (&se, NULL); + if (expr3_desc != NULL_TREE) + { + if (e3_has_nodescriptor) + { + /* The lbound of nondescriptor arrays like array constructors, + nonallocatable/nonpointer function results/variables, + start at zero, but when allocating it, the standard expects + the array to start at one. Therefore fix the upper bound to be + (desc.ubound - desc.lbound) + 1. */ + tmp = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, + gfc_conv_descriptor_ubound_get ( + expr3_desc, gfc_rank_cst[n]), + gfc_conv_descriptor_lbound_get ( + expr3_desc, gfc_rank_cst[n])); + tmp = fold_build2_loc (input_location, PLUS_EXPR, + gfc_array_index_type, tmp, + gfc_index_one_node); + se.expr = gfc_evaluate_now (tmp, pblock); + } + else + se.expr = gfc_conv_descriptor_ubound_get (expr3_desc, + gfc_rank_cst[n]); + } + else + { + gcc_assert (ubound); + gfc_conv_expr_type (&se, ubound, gfc_array_index_type); + gfc_add_block_to_block (pblock, &se.pre); + if (ubound->expr_type == EXPR_FUNCTION) + se.expr = gfc_evaluate_now (se.expr, pblock); + } + gfc_conv_descriptor_ubound_set (descriptor_block, descriptor, + gfc_rank_cst[n], se.expr); + conv_ubound = se.expr; + + /* Store the stride. */ + gfc_conv_descriptor_stride_set (descriptor_block, descriptor, + gfc_rank_cst[n], stride); + + /* Calculate size and check whether extent is negative. */ + size = gfc_conv_array_extent_dim (conv_lbound, conv_ubound, &empty_cond); + size = gfc_evaluate_now (size, pblock); + + /* Check whether multiplying the stride by the number of + elements in this dimension would overflow. We must also check + whether the current dimension has zero size in order to avoid + division by zero. + */ + tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR, + gfc_array_index_type, + fold_convert (gfc_array_index_type, + TYPE_MAX_VALUE (gfc_array_index_type)), + size); + cond = gfc_unlikely (fold_build2_loc (input_location, LT_EXPR, + 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, + logical_type_node, size, + gfc_index_zero_node), + PRED_FORTRAN_SIZE_ZERO); + tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond, + integer_zero_node, tmp); + tmp = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node, + *overflow, tmp); + *overflow = gfc_evaluate_now (tmp, pblock); + + /* Multiply the stride by the number of elements in this dimension. */ + stride = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, stride, size); + stride = gfc_evaluate_now (stride, pblock); + } + + *empty_array_cond = empty_cond; + + for (n = rank; n < rank + corank; n++) + { + ubound = upper[n]; + + /* Set lower bound. */ + gfc_init_se (&se, NULL); + if (lower == NULL || lower[n] == NULL) + { + gcc_assert (n == rank + corank - 1); + se.expr = gfc_index_one_node; + } + else + { + if (ubound || n == rank + corank - 1) + { + gfc_conv_expr_type (&se, lower[n], gfc_array_index_type); + gfc_add_block_to_block (pblock, &se.pre); + } + else + { + se.expr = gfc_index_one_node; + ubound = lower[n]; + } + } + gfc_conv_descriptor_lbound_set (descriptor_block, descriptor, + gfc_rank_cst[n], se.expr); + + if (n < rank + corank - 1) + { + gfc_init_se (&se, NULL); + gcc_assert (ubound); + gfc_conv_expr_type (&se, ubound, gfc_array_index_type); + gfc_add_block_to_block (pblock, &se.pre); + gfc_conv_descriptor_ubound_set (descriptor_block, descriptor, + gfc_rank_cst[n], se.expr); + } + } + + /* The stride is the number of elements in the array, so multiply by the + size of an element to get the total size. */ + + if (rank == 0) + return gfc_index_one_node; + + /* Update the array descriptor with the offset and the span. */ + offset = gfc_evaluate_now (offset, pblock); + gfc_conv_descriptor_offset_set (descriptor_block, descriptor, offset); + tmp = fold_convert (gfc_array_index_type, element_size); + gfc_conv_descriptor_span_set (descriptor_block, descriptor, tmp); + + return stride; +} diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h index 9df22d7b0ba5..f97bc76391fb 100644 --- a/gcc/fortran/trans-descriptor.h +++ b/gcc/fortran/trans-descriptor.h @@ -134,5 +134,10 @@ void gfc_set_descriptor_for_assign_realloc (stmtblock_t *, gfc_loopinfo *, tree, tree, bool); tree gfc_set_pdt_array_descriptor (stmtblock_t *, tree, gfc_array_spec *, gfc_actual_arglist *, tree); +tree +gfc_descriptor_init_count (tree, int, int, gfc_expr **, gfc_expr **, + stmtblock_t * pblock, stmtblock_t *, tree *, + tree, gfc_expr *, tree, bool, gfc_expr *, tree, + bool, tree *); #endif /* GFC_TRANS_DESCRIPTOR_H */