https://gcc.gnu.org/g:d9423e6e9442366d707575aed2bebff537d77642
commit d9423e6e9442366d707575aed2bebff537d77642
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Mon Sep 22 11:12:09 2025 +0200
Extraction build_array_ref
Diff:
---
gcc/fortran/trans-array.cc | 223 ++++++++++++++++++++++++++++-----------------
1 file changed, 141 insertions(+), 82 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 4378cd00253b..ea8d39deeb8f 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -3452,21 +3452,6 @@ array_bound_check_elemental (gfc_se * se, gfc_ss * ss,
gfc_expr * expr)
}
-static tree
-build_array_ref (gfc_array_ref_info * array_ref)
-{
- switch (array_ref->access)
- {
- case gfc_array_ref_info::ARRAY_INDEX:
- break;
- case gfc_array_ref_info::POINTER_OFFSET:
- break;
- }
-
- return NULL_TREE;
-}
-
-
/* Add T to the offset pair *OFFSET, *CST_OFFSET. */
void
@@ -3654,16 +3639,12 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int
dim, int i,
}
-/* Build a scalarized array reference using the vptr 'size'. */
-
static bool
-build_class_array_ref (gfc_se *se, tree base, tree index)
+is_class_array_ref (tree base, gfc_expr *expr, tree *class_descr)
{
- tree size;
tree decl = NULL_TREE;
tree tmp;
- gfc_expr *expr = se->ss->info->expr;
- gfc_expr *class_expr;
+ gfc_expr *class_expr = nullptr;
gfc_typespec *ts;
gfc_symbol *sym;
@@ -3687,7 +3668,7 @@ build_class_array_ref (gfc_se *se, tree base, tree index)
class_expr = gfc_find_and_cut_at_last_class_ref (expr, false, &ts);
if (!ts)
- return false;
+ goto give_up;
sym = (!class_expr && expr) ? expr->symtree->n.sym : NULL;
if (sym && sym->attr.function
@@ -3716,6 +3697,31 @@ build_class_array_ref (gfc_se *se, tree base, tree index)
return false;
}
+ if (class_descr)
+ *class_descr = decl;
+ if (class_expr != nullptr)
+ gfc_free_expr (class_expr);
+ return true;
+
+give_up:
+ if (class_expr != nullptr)
+ gfc_free_expr (class_expr);
+ return false;
+}
+
+
+/* Build a scalarized array reference using the vptr 'size'. */
+
+static bool
+build_class_array_ref (gfc_se *se, tree base, tree index)
+{
+ tree size;
+ tree decl = NULL_TREE;
+ gfc_expr *expr = se->ss->info->expr;
+
+ if (!is_class_array_ref (base, expr, &decl))
+ return false;
+
se->class_vptr = gfc_evaluate_now (gfc_class_vptr_get (decl), &se->pre);
size = gfc_class_vtab_size_get (decl);
@@ -3771,6 +3777,106 @@ non_negative_strides_array_p (tree expr)
}
+enum gfc_array_ref_sort
+{
+ /* A regular array reference. */
+ ARS_REGULAR_ARRAY_REF,
+ /* Pointer arithmetics, with the element size picked from the class
+ descriptor's _size field. */
+ ARS_CLASS_PTR_ARITH,
+ /* Pointer arithmetics, with the element size picked from the array
+ descriptor's span field. */
+ ARS_SPANNED_PTR_ARITH,
+ /* Pointer arithmetics, using the CFI descriptor's sm fields. */
+ ARS_CFI_PTR_ARITH
+};
+
+
+static gfc_array_ref_sort
+classify_array_ref (tree array, tree ref_base, gfc_expr *expr,
+ gfc_array_ref *ar, bool tmp_array)
+{
+ if (is_class_array_ref (ref_base, expr, nullptr))
+ return ARS_CLASS_PTR_ARITH;
+
+ if (get_CFI_desc (NULL, expr, nullptr, ar))
+ return ARS_CFI_PTR_ARITH;
+
+ if (is_pointer_array (array)
+ || (expr && expr->ts.deferred && array
+ && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (array))))
+ return ARS_SPANNED_PTR_ARITH;
+
+ if (tmp_array || non_negative_strides_array_p (array))
+ return ARS_SPANNED_PTR_ARITH;
+
+ return ARS_REGULAR_ARRAY_REF;
+}
+
+
+static void
+build_array_ref (gfc_se *se, tree array, tree ref_base, gfc_expr *expr,
+ gfc_array_ref *ar, bool is_temp_array, tree index)
+{
+ switch (classify_array_ref (array, ref_base, expr, ar, is_temp_array))
+ {
+
+ case ARS_CLASS_PTR_ARITH:
+ {
+ bool success = build_class_array_ref (se, ref_base, index);
+ gcc_assert (success);
+ }
+ break;
+
+ case ARS_CFI_PTR_ARITH:
+ {
+ tree cfi_decl = NULL_TREE;
+ if (get_CFI_desc (NULL, expr, &cfi_decl, ar))
+ cfi_decl = build_fold_indirect_ref_loc (input_location, cfi_decl);
+ bool non_negative_stride = is_temp_array
+ || non_negative_strides_array_p (array);
+ se->expr = gfc_build_array_ref (ref_base, index, non_negative_stride,
+ cfi_decl);
+ }
+ break;
+
+ case ARS_SPANNED_PTR_ARITH:
+ {
+ tree decl = NULL_TREE;
+ if (is_pointer_array (array)
+ || (expr && expr->ts.deferred && array
+ && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (array))))
+ {
+ if (TREE_CODE (array) == COMPONENT_REF)
+ decl = array;
+ else if (INDIRECT_REF_P (array))
+ decl = TREE_OPERAND (array, 0);
+
+ if (decl == NULL_TREE)
+ decl = array;
+ }
+
+ bool non_negative_stride = is_temp_array
+ || non_negative_strides_array_p (array);
+ se->expr = gfc_build_array_ref (ref_base, index, non_negative_stride,
+ decl);
+ }
+ break;
+
+ case ARS_REGULAR_ARRAY_REF:
+ {
+ bool non_negative_stride = is_temp_array
+ || non_negative_strides_array_p (array);
+ se->expr = gfc_build_array_ref (ref_base, index, non_negative_stride);
+ }
+ break;
+
+ default:
+ gcc_unreachable ();
+ }
+}
+
+
/* Build a scalarized reference to an array. */
static void
@@ -3778,7 +3884,6 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref
* ar,
bool tmp_array = false)
{
gfc_array_info *info;
- tree decl = NULL_TREE;
tree base;
gfc_ss *ss;
gfc_expr *expr;
@@ -3797,32 +3902,7 @@ gfc_conv_scalarized_array_ref (gfc_se * se,
gfc_array_ref * ar,
base = build_fold_indirect_ref_loc (input_location, info->current_elem.base);
- /* Use the vptr 'size' field to access the element of a class array. */
- if (build_class_array_ref (se, base, index))
- return;
-
- if (get_CFI_desc (NULL, expr, &decl, ar))
- decl = build_fold_indirect_ref_loc (input_location, decl);
-
- /* A pointer array component can be detected from its field decl. Fix
- the descriptor, mark the resulting variable decl and pass it to
- gfc_build_array_ref. */
- if (is_pointer_array (info->descriptor)
- || (expr && expr->ts.deferred && info->descriptor
- && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (info->descriptor))))
- {
- if (TREE_CODE (info->descriptor) == COMPONENT_REF)
- decl = info->descriptor;
- else if (INDIRECT_REF_P (info->descriptor))
- decl = TREE_OPERAND (info->descriptor, 0);
-
- if (decl == NULL_TREE)
- decl = info->descriptor;
- }
-
- bool non_negative_stride = tmp_array
- || non_negative_strides_array_p (info->descriptor);
- se->expr = gfc_build_array_ref (base, index, non_negative_stride, decl);
+ build_array_ref (se, info->descriptor, base, expr, ar, tmp_array, index);
}
@@ -3837,39 +3917,13 @@ gfc_conv_tmp_array_ref (gfc_se * se)
}
-static tree
-build_array_ref (tree desc, tree offset, tree decl, tree vptr)
+static void
+build_array_ref (gfc_se *se, tree array, gfc_expr *expr, gfc_array_ref *ar,
+ tree index)
{
- tree tmp;
- tree type;
- tree cdesc;
-
- /* For class arrays the class declaration is stored in the saved
- descriptor. */
- if (INDIRECT_REF_P (desc)
- && DECL_LANG_SPECIFIC (TREE_OPERAND (desc, 0))
- && GFC_DECL_SAVED_DESCRIPTOR (TREE_OPERAND (desc, 0)))
- cdesc = gfc_class_data_get (GFC_DECL_SAVED_DESCRIPTOR (
- TREE_OPERAND (desc, 0)));
- else
- cdesc = desc;
-
- /* Class container types do not always have the GFC_CLASS_TYPE_P
- but the canonical type does. */
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (cdesc))
- && TREE_CODE (cdesc) == COMPONENT_REF)
- {
- type = TREE_TYPE (TREE_OPERAND (cdesc, 0));
- if (TYPE_CANONICAL (type)
- && GFC_CLASS_TYPE_P (TYPE_CANONICAL (type)))
- vptr = gfc_class_vptr_get (TREE_OPERAND (cdesc, 0));
- }
-
- tmp = gfc_conv_array_data (desc);
+ tree tmp = gfc_conv_array_data (array);
tmp = build_fold_indirect_ref_loc (input_location, tmp);
- tmp = gfc_build_array_ref (tmp, offset, non_negative_strides_array_p (desc),
- decl, vptr);
- return tmp;
+ build_array_ref (se, array, tmp, expr, ar, false, index);
}
@@ -4064,7 +4118,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar,
gfc_expr *expr,
}
free (var_name);
- se->expr = build_array_ref (se->expr, index, decl, se->class_vptr);
+ build_array_ref (se, se->expr, expr, ar, index);
}
@@ -7146,7 +7200,12 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm,
tree desc, tree offset,
return;
}
- tmp = build_array_ref (desc, offset, NULL, NULL);
+ gfc_se se;
+ gfc_init_se (&se, nullptr);
+ build_array_ref (&se, desc, expr, gfc_find_array_ref (expr, false), offset);
+ gfc_add_block_to_block (block, &se.pre);
+ tmp = gfc_evaluate_now (se.expr, block);
+ gfc_add_block_to_block (block, &se.post);
/* Offset the data pointer for pointer assignments from arrays with
subreferences; e.g. my_integer => my_type(:)%integer_component. */
