[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Déplacement gfc_array_init_count -> gfc_descriptor_init_count
Mikael Morin
mikael@gcc.gnu.org
Wed Sep 17 15:45:02 GMT 2025
https://gcc.gnu.org/g:6d9ca3056a95456cb8b796818bde13a789525341
commit 6d9ca3056a95456cb8b796818bde13a789525341
Author: Mikael Morin <mikael@gcc.gnu.org>
Date: Thu Jul 31 16:51:20 2025 +0200
Déplacement gfc_array_init_count -> gfc_descriptor_init_count
Diff:
---
gcc/fortran/trans-array.cc | 301 ++--------------------------------------
gcc/fortran/trans-descriptor.cc | 283 +++++++++++++++++++++++++++++++++++++
gcc/fortran/trans-descriptor.h | 5 +
3 files changed, 297 insertions(+), 292 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index ea2723064cd4..a0ab5a284015 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -5817,289 +5817,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_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. */
@@ -6262,15 +5979,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 5ab51ad326f2..867daf831f53 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -2507,3 +2507,286 @@ gfc_grow_array (stmtblock_t * pblock, tree desc, tree extra)
}
+/* 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_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 f383cd97c262..c3b33f3d5c2f 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -148,5 +148,10 @@ void gfc_set_descriptor_for_assign_realloc (stmtblock_t *, gfc_loopinfo *,
tree gfc_set_pdt_array_descriptor (stmtblock_t *, tree, gfc_array_spec *,
gfc_actual_arglist *, tree);
void gfc_grow_array (stmtblock_t *, tree, 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 */
More information about the Gcc-cvs
mailing list