https://gcc.gnu.org/g:7f62dd3e9b80ee4fbef54b407bc55c3131c0b9d3
commit 7f62dd3e9b80ee4fbef54b407bc55c3131c0b9d3
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Wed Jul 23 22:21:15 2025 +0200
Extraction get_array_memory_size
Diff:
---
gcc/fortran/trans-array.cc | 155 ++++++++++++++++++++++++---------------------
1 file changed, 84 insertions(+), 71 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 24f4d9695a0f..f895c3c7e286 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -5782,6 +5782,63 @@ descriptor_element_size (tree descriptor, tree
expr3_elem_size,
}
+static tree
+get_array_memory_size (tree element_size, tree elements_count,
+ tree empty_array_cond, stmtblock_t *pblock,
+ tree *overflow)
+{
+ elements_count = fold_convert (size_type_node, elements_count);
+
+ /* First check for overflow. Since an array of type character can
+ have zero element_size, we must check for that before
+ dividing. */
+ tree tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+ size_type_node, TYPE_MAX_VALUE (size_type_node),
+ element_size);
+ tree cond = gfc_unlikely (fold_build2_loc (input_location, LT_EXPR,
+ logical_type_node, tmp,
+ elements_count),
+ 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, 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,
+ integer_zero_node, tmp);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node,
+ *overflow, tmp);
+ *overflow = gfc_evaluate_now (tmp, pblock);
+
+ tree size = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
+ elements_count, element_size);
+
+ if (integer_zerop (empty_array_cond))
+ return size;
+ if (integer_onep (empty_array_cond))
+ return build_int_cst (size_type_node, 0);
+
+ tree var = gfc_create_var (TREE_TYPE (size), "size");
+
+ stmtblock_t thenblock;
+ gfc_start_block (&thenblock);
+ gfc_add_modify (&thenblock, var, build_int_cst (size_type_node, 0));
+ tree thencase = gfc_finish_block (&thenblock);
+
+ stmtblock_t elseblock;
+ gfc_start_block (&elseblock);
+ gfc_add_modify (&elseblock, var, size);
+ tree elsecase = gfc_finish_block (&elseblock);
+
+ tmp = gfc_evaluate_now (empty_array_cond, pblock);
+ tmp = build3_v (COND_EXPR, tmp, thencase, elsecase);
+ gfc_add_expr_to_block (pblock, tmp);
+
+ return var;
+}
+
+
/* 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,
@@ -5814,25 +5871,20 @@ descriptor_element_size (tree descriptor, tree
expr3_elem_size,
/*GCC ARRAYS*/
static tree
-gfc_array_init_size (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)
+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 or_expr;
- tree thencase;
- tree elsecase;
tree cond;
- tree var;
- stmtblock_t thenblock;
- stmtblock_t elseblock;
gfc_expr *ubound;
gfc_se se;
int n;
@@ -5884,7 +5936,7 @@ gfc_array_init_size (tree descriptor, int rank, int
corank, gfc_expr ** lower,
else
gfc_conv_descriptor_dtype_set (pblock, descriptor, gfc_get_dtype (type));
- or_expr = logical_false_node;
+ tree empty_cond = logical_false_node;
for (n = 0; n < rank; n++)
{
@@ -5980,7 +6032,7 @@ gfc_array_init_size (tree descriptor, int rank, int
corank, gfc_expr ** lower,
gfc_rank_cst[n], stride);
/* Calculate size and check whether extent is negative. */
- size = gfc_conv_array_extent_dim (conv_lbound, conv_ubound, &or_expr);
+ 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
@@ -6014,6 +6066,8 @@ gfc_array_init_size (tree descriptor, int rank, int
corank, gfc_expr ** lower,
stride = gfc_evaluate_now (stride, pblock);
}
+ *empty_array_cond = empty_cond;
+
for (n = rank; n < rank + corank; n++)
{
ubound = upper[n];
@@ -6056,7 +6110,7 @@ gfc_array_init_size (tree descriptor, int rank, int
corank, gfc_expr ** lower,
size of an element to get the total size. */
if (rank == 0)
- return element_size;
+ return gfc_index_one_node;
/* Update the array descriptor with the offset and the span. */
offset = gfc_evaluate_now (offset, pblock);
@@ -6064,51 +6118,7 @@ gfc_array_init_size (tree descriptor, int rank, int
corank, gfc_expr ** lower,
tmp = fold_convert (gfc_array_index_type, element_size);
gfc_conv_descriptor_span_set (descriptor_block, descriptor, tmp);
- stride = fold_convert (size_type_node, stride);
-
- /* First check for overflow. Since an array of type character can
- have zero element_size, we must check for that before
- dividing. */
- tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
- size_type_node,
- TYPE_MAX_VALUE (size_type_node), element_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, 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,
- integer_zero_node, tmp);
- tmp = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node,
- *overflow, tmp);
- *overflow = gfc_evaluate_now (tmp, pblock);
-
- size = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
- stride, element_size);
-
- if (integer_zerop (or_expr))
- return size;
- if (integer_onep (or_expr))
- return build_int_cst (size_type_node, 0);
-
- var = gfc_create_var (TREE_TYPE (size), "size");
- gfc_start_block (&thenblock);
- gfc_add_modify (&thenblock, var, build_int_cst (size_type_node, 0));
- thencase = gfc_finish_block (&thenblock);
-
- gfc_start_block (&elseblock);
- gfc_add_modify (&elseblock, var, size);
- elsecase = gfc_finish_block (&elseblock);
-
- tmp = gfc_evaluate_now (or_expr, pblock);
- tmp = build3_v (COND_EXPR, tmp, thencase, elsecase);
- gfc_add_expr_to_block (pblock, tmp);
-
- return var;
+ return stride;
}
@@ -6152,7 +6162,6 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree
status, tree errmsg,
tree tmp;
tree pointer;
tree token = NULL_TREE;
- tree size;
tree msg;
tree error = NULL_TREE;
tree overflow; /* Boolean storing whether size calculation overflows. */
@@ -6268,21 +6277,25 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree
status, tree errmsg,
fold_convert (TREE_TYPE (expr->ts.u.cl->backend_decl),
se->string_length));
- gfc_init_block (&set_descriptor_block);
-
-
element_size = descriptor_element_size (se->expr, expr3_elem_size, expr3);
/* Take the corank only from the actual ref and not from the coref. The
later will mislead the generation of the array dimensions for allocatable/
pointer components in derived types. */
- size = gfc_array_init_size (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);
+ 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);
+
+ tree size = get_array_memory_size (element_size, count, empty_array_cond,
+ &se->pre, &overflow);
if (dimension)
{
