https://gcc.gnu.org/g:907d363c5dfcf80a95bc0fa44b11268b95724a71
commit 907d363c5dfcf80a95bc0fa44b11268b95724a71
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Wed Apr 2 16:28:11 2025 +0200
Sauvegarde modifs.
Diff:
---
gcc/fortran/class.cc | 244 +++-----------
gcc/fortran/intrinsic.cc | 8 -
gcc/fortran/trans-array.cc | 690 ++++++++++++++++++++++++----------------
gcc/fortran/trans-array.h | 3 +-
gcc/fortran/trans-decl.cc | 6 +-
gcc/fortran/trans-descriptor.cc | 267 ++++++++--------
gcc/fortran/trans-expr.cc | 4 +-
gcc/fortran/trans-intrinsic.cc | 46 +--
gcc/fortran/trans-io.cc | 53 ++-
gcc/fortran/trans-openmp.cc | 2 +-
gcc/fortran/trans-types.cc | 61 ++--
gcc/fortran/trans.h | 34 +-
libgfortran/io/transfer.c | 4 +-
13 files changed, 690 insertions(+), 732 deletions(-)
diff --git a/gcc/fortran/class.cc b/gcc/fortran/class.cc
index 41be63bf768f..f7442f5c22ec 100644
--- a/gcc/fortran/class.cc
+++ b/gcc/fortran/class.cc
@@ -1491,19 +1491,12 @@ finalization_get_offset (gfc_symbol *idx, gfc_symbol
*idx2, gfc_symbol *offset,
static void
finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini,
gfc_symbol *array, gfc_symbol *byte_stride,
- gfc_symbol *idx, gfc_symbol *ptr,
- gfc_symbol *nelem,
- gfc_symbol *strides, gfc_symbol *sizes,
- gfc_symbol *idx2, gfc_symbol *offset,
- gfc_symbol *is_contiguous, gfc_expr *rank,
+ gfc_symbol *nelem, gfc_symbol *is_contiguous,
gfc_namespace *sub_ns)
{
- gfc_symbol *tmp_array, *ptr2;
- gfc_expr *size_expr, *offset2, *expr;
+ gfc_symbol *ptr2;
+ gfc_expr *size_expr, *expr;
gfc_namespace *ns;
- gfc_iterator *iter;
- gfc_code *block2;
- int i;
block->next = gfc_get_code (EXEC_IF);
block = block->next;
@@ -1611,81 +1604,26 @@ finalizer_insert_packed_call (gfc_code *block,
gfc_finalizer *fini,
ptr2->attr.flavor = FL_VARIABLE;
ptr2->attr.pointer = 1;
ptr2->attr.artificial = 1;
+ ptr2->attr.dimension = 1;
+ ptr2->as = gfc_get_array_spec ();
+ ptr2->as->type = AS_DEFERRED;
+ ptr2->as->rank = 1;
gfc_set_sym_referenced (ptr2);
gfc_commit_symbol (ptr2);
- gfc_get_symbol ("tmp_array", ns, &tmp_array);
- tmp_array->ts.type = BT_DERIVED;
- tmp_array->ts.u.derived = array->ts.u.derived;
- tmp_array->attr.flavor = FL_VARIABLE;
- tmp_array->attr.dimension = 1;
- tmp_array->attr.artificial = 1;
- tmp_array->as = gfc_get_array_spec();
- tmp_array->attr.intent = INTENT_INOUT;
- tmp_array->as->type = AS_EXPLICIT;
- tmp_array->as->rank = fini->proc_tree->n.sym->formal->sym->as->rank;
-
- for (i = 0; i < tmp_array->as->rank; i++)
- {
- gfc_expr *shape_expr;
- tmp_array->as->lower[i] = gfc_get_int_expr (gfc_default_integer_kind,
- NULL, 1);
- /* SIZE (array, dim=i+1, kind=gfc_index_integer_kind). */
- shape_expr
- = gfc_build_intrinsic_call (sub_ns, GFC_ISYM_SIZE, "size",
- gfc_current_locus, 3,
- gfc_lval_expr_from_sym (array),
- gfc_get_int_expr (gfc_default_integer_kind,
- NULL, i+1),
- gfc_get_int_expr (gfc_default_integer_kind,
- NULL,
- gfc_index_integer_kind));
- shape_expr->ts.kind = gfc_index_integer_kind;
- tmp_array->as->upper[i] = shape_expr;
- }
- gfc_set_sym_referenced (tmp_array);
- gfc_commit_symbol (tmp_array);
-
- /* Create loop. */
- iter = gfc_get_iterator ();
- iter->var = gfc_lval_expr_from_sym (idx);
- iter->start = gfc_get_int_expr (gfc_index_integer_kind, NULL, 0);
- iter->end = gfc_lval_expr_from_sym (nelem);
- iter->step = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1);
-
- block = gfc_get_code (EXEC_DO);
+ block = gfc_get_code (EXEC_POINTER_ASSIGN);
ns->code = block;
- block->ext.iterator = iter;
- block->block = gfc_get_code (EXEC_DO);
-
- /* Offset calculation for the new array: idx * size of type (in bytes). */
- offset2 = gfc_get_expr ();
- offset2->expr_type = EXPR_OP;
- offset2->where = gfc_current_locus;
- offset2->value.op.op = INTRINSIC_TIMES;
- offset2->value.op.op1 = gfc_lval_expr_from_sym (idx);
- offset2->value.op.op2 = gfc_copy_expr (size_expr);
- offset2->ts = byte_stride->ts;
-
- /* Offset calculation of "array". */
- block2 = finalization_get_offset (idx, idx2, offset, strides, sizes,
- byte_stride, rank, block->block, sub_ns);
-
- /* Create code for
- CALL C_F_POINTER (TRANSFER (TRANSFER (C_LOC (array, cptr), c_intptr)
- + idx * stride, c_ptr), ptr). */
- block2->next = finalization_scalarizer (array, ptr,
- gfc_lval_expr_from_sym (offset),
- sub_ns);
- block2 = block2->next;
- block2->next = finalization_scalarizer (tmp_array, ptr2, offset2, sub_ns);
- block2 = block2->next;
-
- /* ptr2 = ptr. */
- block2->next = gfc_get_code (EXEC_ASSIGN);
- block2 = block2->next;
- block2->expr1 = gfc_lval_expr_from_sym (ptr2);
- block2->expr2 = gfc_lval_expr_from_sym (ptr);
+ block->expr1 = gfc_lval_expr_from_sym (ptr2);
+ gfc_free_ref_list (block->expr1->ref);
+ block->expr1->ref = gfc_get_ref ();
+ block->expr1->ref->type = REF_ARRAY;
+ block->expr1->ref->u.ar.type = AR_SECTION;
+ block->expr1->ref->u.ar.dimen = 1;
+ block->expr1->ref->u.ar.as = ptr2->as;
+ block->expr1->ref->u.ar.dimen_type[0] = DIMEN_RANGE;
+ block->expr1->ref->u.ar.start[0] = gfc_get_int_expr (gfc_index_integer_kind,
nullptr, 1);
+ block->expr1->ref->u.ar.end[0] = gfc_lval_expr_from_sym (nelem);
+ block->expr2 = gfc_lval_expr_from_sym (array);
/* Call now the user's final subroutine. */
block->next = gfc_get_code (EXEC_CALL);
@@ -1693,44 +1631,7 @@ finalizer_insert_packed_call (gfc_code *block,
gfc_finalizer *fini,
block->symtree = fini->proc_tree;
block->resolved_sym = fini->proc_tree->n.sym;
block->ext.actual = gfc_get_actual_arglist ();
- block->ext.actual->expr = gfc_lval_expr_from_sym (tmp_array);
-
- if (fini->proc_tree->n.sym->formal->sym->attr.intent == INTENT_IN)
- return;
-
- /* Copy back. */
-
- /* Loop. */
- iter = gfc_get_iterator ();
- iter->var = gfc_lval_expr_from_sym (idx);
- iter->start = gfc_get_int_expr (gfc_index_integer_kind, NULL, 0);
- iter->end = gfc_lval_expr_from_sym (nelem);
- iter->step = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1);
-
- block->next = gfc_get_code (EXEC_DO);
- block = block->next;
- block->ext.iterator = iter;
- block->block = gfc_get_code (EXEC_DO);
-
- /* Offset calculation of "array". */
- block2 = finalization_get_offset (idx, idx2, offset, strides, sizes,
- byte_stride, rank, block->block, sub_ns);
-
- /* Create code for
- CALL C_F_POINTER (TRANSFER (TRANSFER (C_LOC (array, cptr), c_intptr)
- + offset, c_ptr), ptr). */
- block2->next = finalization_scalarizer (array, ptr,
- gfc_lval_expr_from_sym (offset),
- sub_ns);
- block2 = block2->next;
- block2->next = finalization_scalarizer (tmp_array, ptr2,
- gfc_copy_expr (offset2), sub_ns);
- block2 = block2->next;
-
- /* ptr = ptr2. */
- block2->next = gfc_get_code (EXEC_ASSIGN);
- block2->next->expr1 = gfc_lval_expr_from_sym (ptr);
- block2->next->expr2 = gfc_lval_expr_from_sym (ptr2);
+ block->ext.actual->expr = gfc_lval_expr_from_sym (ptr2);
}
@@ -2025,29 +1926,10 @@ generate_finalization_wrapper (gfc_symbol *derived,
gfc_namespace *ns,
last_code->ext.iterator = iter;
last_code->block = gfc_get_code (EXEC_DO);
- /* strides(idx) = _F._stride(array,dim=idx). */
+ /* sizes(idx) = ... */
last_code->block->next = gfc_get_code (EXEC_ASSIGN);
block = last_code->block->next;
- block->expr1 = gfc_lval_expr_from_sym (strides);
- block->expr1->ref = gfc_get_ref ();
- block->expr1->ref->type = REF_ARRAY;
- block->expr1->ref->u.ar.type = AR_ELEMENT;
- block->expr1->ref->u.ar.dimen = 1;
- block->expr1->ref->u.ar.dimen_type[0] = DIMEN_ELEMENT;
- block->expr1->ref->u.ar.start[0] = gfc_lval_expr_from_sym (idx);
- block->expr1->ref->u.ar.as = strides->as;
-
- block->expr2 = gfc_build_intrinsic_call (sub_ns, GFC_ISYM_STRIDE, "stride",
- gfc_current_locus, 2,
- gfc_lval_expr_from_sym (array),
- gfc_lval_expr_from_sym (idx));
-
- /* sizes(idx) = sizes(idx-1) * size(array,dim=idx, kind=index_kind). */
- block->next = gfc_get_code (EXEC_ASSIGN);
- block = block->next;
-
- /* sizes(idx) = ... */
block->expr1 = gfc_lval_expr_from_sym (sizes);
block->expr1->ref = gfc_get_ref ();
block->expr1->ref->type = REF_ARRAY;
@@ -2093,54 +1975,13 @@ generate_finalization_wrapper (gfc_symbol *derived,
gfc_namespace *ns,
block->expr2->value.op.op2->ts.kind = gfc_index_integer_kind;
block->expr2->ts = idx->ts;
- /* if (strides (idx) /= sizes(idx-1)) is_contiguous = .false. */
- block->next = gfc_get_code (EXEC_IF);
- block = block->next;
-
- block->block = gfc_get_code (EXEC_IF);
- block = block->block;
-
- /* if condition: strides(idx) /= sizes(idx-1). */
- block->expr1 = gfc_get_expr ();
- block->expr1->ts.type = BT_LOGICAL;
- block->expr1->ts.kind = gfc_default_logical_kind;
- block->expr1->expr_type = EXPR_OP;
- block->expr1->where = gfc_current_locus;
- block->expr1->value.op.op = INTRINSIC_NE;
-
- block->expr1->value.op.op1 = gfc_lval_expr_from_sym (strides);
- block->expr1->value.op.op1->ref = gfc_get_ref ();
- block->expr1->value.op.op1->ref->type = REF_ARRAY;
- block->expr1->value.op.op1->ref->u.ar.type = AR_ELEMENT;
- block->expr1->value.op.op1->ref->u.ar.dimen = 1;
- block->expr1->value.op.op1->ref->u.ar.dimen_type[0] = DIMEN_ELEMENT;
- block->expr1->value.op.op1->ref->u.ar.start[0] = gfc_lval_expr_from_sym
(idx);
- block->expr1->value.op.op1->ref->u.ar.as = strides->as;
-
- block->expr1->value.op.op2 = gfc_lval_expr_from_sym (sizes);
- block->expr1->value.op.op2->ref = gfc_get_ref ();
- block->expr1->value.op.op2->ref->type = REF_ARRAY;
- block->expr1->value.op.op2->ref->u.ar.as = sizes->as;
- block->expr1->value.op.op2->ref->u.ar.type = AR_ELEMENT;
- block->expr1->value.op.op2->ref->u.ar.dimen = 1;
- block->expr1->value.op.op2->ref->u.ar.dimen_type[0] = DIMEN_ELEMENT;
- block->expr1->value.op.op2->ref->u.ar.start[0] = gfc_get_expr ();
- block->expr1->value.op.op2->ref->u.ar.start[0]->expr_type = EXPR_OP;
- block->expr1->value.op.op2->ref->u.ar.start[0]->where = gfc_current_locus;
- block->expr1->value.op.op2->ref->u.ar.start[0]->value.op.op =
INTRINSIC_MINUS;
- block->expr1->value.op.op2->ref->u.ar.start[0]->value.op.op1
- = gfc_lval_expr_from_sym (idx);
- block->expr1->value.op.op2->ref->u.ar.start[0]->value.op.op2
- = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1);
- block->expr1->value.op.op2->ref->u.ar.start[0]->ts
- = block->expr1->value.op.op2->ref->u.ar.start[0]->value.op.op1->ts;
-
- /* if body: is_contiguous = .false. */
- block->next = gfc_get_code (EXEC_ASSIGN);
- block = block->next;
- block->expr1 = gfc_lval_expr_from_sym (is_contiguous);
- block->expr2 = gfc_get_logical_expr (gfc_default_logical_kind,
- &gfc_current_locus, false);
+ /* is_contiguous = is_contiguous(array) */
+ last_code->next = gfc_get_code (EXEC_ASSIGN);
+ last_code = last_code->next;
+ last_code->expr1 = gfc_lval_expr_from_sym (is_contiguous);
+ last_code->expr2 = gfc_build_intrinsic_call (sub_ns, GFC_ISYM_IS_CONTIGUOUS,
+ "is_contiguous", gfc_current_locus,
1,
+ gfc_lval_expr_from_sym (array));
/* Obtain the size (number of elements) of "array" MINUS ONE,
which is used in the scalarization. */
@@ -2152,28 +1993,21 @@ generate_finalization_wrapper (gfc_symbol *derived,
gfc_namespace *ns,
gfc_set_sym_referenced (nelem);
gfc_commit_symbol (nelem);
- /* nelem = sizes (rank) - 1. */
+ /* nelem = sizes (rank) */
last_code->next = gfc_get_code (EXEC_ASSIGN);
last_code = last_code->next;
last_code->expr1 = gfc_lval_expr_from_sym (nelem);
last_code->expr2 = gfc_get_expr ();
- last_code->expr2->expr_type = EXPR_OP;
- last_code->expr2->value.op.op = INTRINSIC_MINUS;
- last_code->expr2->value.op.op2
- = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1);
- last_code->expr2->ts = last_code->expr2->value.op.op2->ts;
- last_code->expr2->where = gfc_current_locus;
-
- last_code->expr2->value.op.op1 = gfc_lval_expr_from_sym (sizes);
- last_code->expr2->value.op.op1->ref = gfc_get_ref ();
- last_code->expr2->value.op.op1->ref->type = REF_ARRAY;
- last_code->expr2->value.op.op1->ref->u.ar.type = AR_ELEMENT;
- last_code->expr2->value.op.op1->ref->u.ar.dimen = 1;
- last_code->expr2->value.op.op1->ref->u.ar.dimen_type[0] = DIMEN_ELEMENT;
- last_code->expr2->value.op.op1->ref->u.ar.start[0] = gfc_copy_expr (rank);
- last_code->expr2->value.op.op1->ref->u.ar.as = sizes->as;
+ last_code->expr2 = gfc_lval_expr_from_sym (sizes);
+ last_code->expr2->ref = gfc_get_ref ();
+ last_code->expr2->ref->type = REF_ARRAY;
+ last_code->expr2->ref->u.ar.type = AR_ELEMENT;
+ last_code->expr2->ref->u.ar.dimen = 1;
+ last_code->expr2->ref->u.ar.dimen_type[0] = DIMEN_ELEMENT;
+ last_code->expr2->ref->u.ar.start[0] = gfc_copy_expr (rank);
+ last_code->expr2->ref->u.ar.as = sizes->as;
/* Call final subroutines. We now generate code like:
use iso_c_binding
@@ -2266,9 +2100,7 @@ generate_finalization_wrapper (gfc_symbol *derived,
gfc_namespace *ns,
/* CALL fini_rank (array) - possibly with packing. */
if (fini->proc_tree->n.sym->formal->sym->attr.dimension)
finalizer_insert_packed_call (block, fini, array, byte_stride,
- idx, ptr, nelem, strides,
- sizes, idx2, offset, is_contiguous,
- rank, sub_ns);
+ nelem, is_contiguous, sub_ns);
else
{
block->next = gfc_get_code (EXEC_CALL);
diff --git a/gcc/fortran/intrinsic.cc b/gcc/fortran/intrinsic.cc
index 30f532b5766b..417d285ec308 100644
--- a/gcc/fortran/intrinsic.cc
+++ b/gcc/fortran/intrinsic.cc
@@ -3125,14 +3125,6 @@ add_functions (void)
make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
- /* Obtain the stride for a given dimensions; to be used only internally.
- "make_from_module" makes it inaccessible for external users. */
- add_sym_2 (GFC_PREFIX ("stride"), GFC_ISYM_STRIDE, CLASS_INQUIRY, ACTUAL_NO,
- BT_INTEGER, gfc_index_integer_kind, GFC_STD_GNU,
- NULL, NULL, gfc_resolve_stride,
- ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
- make_from_module();
-
add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, CLASS_INQUIRY, ACTUAL_NO,
BT_INTEGER, ii, GFC_STD_GNU,
gfc_check_sizeof, gfc_simplify_sizeof, NULL,
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 595ba97aa8ca..b33ba5730f24 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -932,7 +932,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t
* post, gfc_ss * ss,
gfc_loopinfo *loop;
gfc_ss *s;
gfc_array_info *info;
- tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS],
stride[GFC_MAX_DIMENSIONS];
+ tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS],
sm[GFC_MAX_DIMENSIONS];
tree type;
tree desc;
tree tmp;
@@ -964,6 +964,10 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
if (class_expr == NULL_TREE && GFC_CLASS_TYPE_P (eltype))
class_expr = get_class_info_from_ss (pre, ss, &eltype, &fcn_ss);
+ bool array_access = class_expr == NULL_TREE
+ && eltype != NULL_TREE
+ && !GFC_CLASS_TYPE_P (eltype);
+
/* If the dynamic type is not available, use the declared type. */
if (eltype && GFC_CLASS_TYPE_P (eltype))
eltype = gfc_get_element_type (TREE_TYPE (TYPE_FIELDS (eltype)));
@@ -1144,7 +1148,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
}
info->descriptor = desc;
- size = gfc_index_one_node;
+ info->array_access = array_access;
+ size = elemsize;
/*
Fill in the bounds and stride. This is a packed array, so:
@@ -1188,7 +1193,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
{
for (n = 0; n < total_dim; n++)
{
- stride[n] = size;
+ sm[n] = size;
tree extent = to[n];
if (!shift_bounds && !integer_zerop (from[n]))
@@ -1241,7 +1246,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
dealloc);
gfc_set_temporary_descriptor (pre, desc, class_expr, elemsize, data_ptr,
- from, to, stride, total_dim, !bounds_known,
+ from, to, sm, total_dim, !bounds_known,
rank_changer, shift_bounds);
while (ss->parent)
@@ -2175,6 +2180,35 @@ gfc_build_constant_array_constructor (gfc_expr * expr,
tree type)
}
+static bool
+array_access_safe_p (gfc_expr *expr)
+{
+ if (expr->ts.type == BT_CLASS)
+ return false;
+
+ if (gfc_is_simply_contiguous (expr, false, true))
+ return true;
+
+ symbol_attribute attr = gfc_expr_attr (expr);
+ if (attr.pointer)
+ return false;
+
+ if (expr->expr_type == EXPR_VARIABLE
+ && attr.dummy)
+ {
+ gfc_symbol *sym = expr->symtree->n.sym;
+
+ gfc_array_spec *as = sym->as;
+ if (as
+ && !(as->type == AS_EXPLICIT
+ || as->type == AS_ASSUMED_SIZE))
+ return false;
+ }
+
+ return true;
+}
+
+
/* Translate a constant EXPR_ARRAY array constructor for the scalarizer.
This mostly initializes the scalarizer state info structure with the
appropriate values to directly use the array created by the function
@@ -2192,6 +2226,7 @@ trans_constant_array_constructor (gfc_ss * ss, tree type)
info = &ss->info->data.array;
info->descriptor = tmp;
+ info->array_access = array_access_safe_p (ss->info->expr);
info->data = gfc_build_addr_expr (NULL_TREE, tmp);
info->offset = gfc_index_zero_node;
@@ -2793,9 +2828,11 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss,
bool subscript,
end = gfc_evaluate_now (end, &outer_loop->pre);
info->end[dim] = end;
- tree stride = gfc_conv_descriptor_stride_get (tmp,
tree_dim);
- stride = gfc_evaluate_now (stride, &outer_loop->pre);
- info->stride[dim] = stride;
+ info->stride[dim] = gfc_index_one_node;
+
+ tree spacing = gfc_conv_descriptor_sm_get (tmp, tree_dim);
+ spacing = gfc_evaluate_now (spacing, &outer_loop->pre);
+ info->spacing[dim] = spacing;
}
}
gfc_add_block_to_block (&outer_loop->post, &se.post);
@@ -2916,6 +2953,7 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss,
int base)
else
info->descriptor = gfc_evaluate_now (se.expr, block);
}
+ info->array_access = array_access_safe_p (ss_info->expr);
ss_info->string_length = se.string_length;
ss_info->class_container = se.class_container;
@@ -2936,20 +2974,21 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss *
ss, int base)
TYPE_NAME (arraytype)));
}
/* Also the data pointer. */
- tmp = gfc_conv_array_data (se.expr);
+ tree data = gfc_conv_array_data (se.expr);
/* If this is a variable or address or a class array, use it directly.
Otherwise we must evaluate it now to avoid breaking dependency
analysis by pulling the expressions for elemental array indices
inside the loop. */
- if (!(DECL_P (tmp)
- || (TREE_CODE (tmp) == ADDR_EXPR
- && DECL_P (TREE_OPERAND (tmp, 0)))
+ if (!(DECL_P (data)
+ || (TREE_CODE (data) == ADDR_EXPR
+ && DECL_P (TREE_OPERAND (data, 0)))
|| (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr))
&& TREE_CODE (se.expr) == COMPONENT_REF
&& GFC_CLASS_TYPE_P (TREE_TYPE (TREE_OPERAND (se.expr, 0)))))
&& !ss->is_alloc_lhs)
- tmp = gfc_evaluate_now (tmp, block);
- info->data = tmp;
+ data = gfc_evaluate_now (data, block);
+ info->data = data;
+ info->saved_data = data;
tmp = gfc_conv_array_offset (se.expr);
if (!ss->is_alloc_lhs)
@@ -3037,7 +3076,7 @@ gfc_conv_array_offset (tree descriptor)
/* Get an expression for the array stride. */
tree
-gfc_conv_array_stride (tree descriptor, int dim)
+gfc_conv_array_sm (tree descriptor, int dim)
{
tree tmp;
tree type;
@@ -3045,16 +3084,16 @@ gfc_conv_array_stride (tree descriptor, int dim)
type = TREE_TYPE (descriptor);
/* For descriptorless arrays use the array size. */
- tmp = GFC_TYPE_ARRAY_STRIDE (type, dim);
+ tmp = GFC_TYPE_ARRAY_SM (type, dim);
if (tmp != NULL_TREE)
return tmp;
- tmp = gfc_conv_descriptor_stride_get (descriptor, gfc_rank_cst[dim]);
+ tmp = gfc_conv_descriptor_sm_get (descriptor, gfc_rank_cst[dim]);
return tmp;
}
-/* Like gfc_conv_array_stride, but for the lower bound. */
+/* Like gfc_conv_array_sm, but for the lower bound. */
tree
gfc_conv_array_lbound (tree descriptor, int dim)
@@ -3073,7 +3112,7 @@ gfc_conv_array_lbound (tree descriptor, int dim)
}
-/* Like gfc_conv_array_stride, but for the upper bound. */
+/* Like gfc_conv_array_sm, but for the upper bound. */
tree
gfc_conv_array_ubound (tree descriptor, int dim)
@@ -3097,6 +3136,16 @@ gfc_conv_array_ubound (tree descriptor, int dim)
}
+tree
+gfc_conv_array_extent (tree descriptor, int dim)
+{
+ tree lbound = gfc_conv_array_lbound (descriptor, dim);
+ tree ubound = gfc_conv_array_ubound (descriptor, dim);
+
+ return gfc_conv_array_extent_dim (lbound, ubound, nullptr);
+}
+
+
/* Generate abridged name of a part-ref for use in bounds-check message.
Cases:
(1) for an ordinary array variable x return "x"
@@ -3299,122 +3348,6 @@ array_bound_check_elemental (gfc_se * se, gfc_ss * ss,
gfc_expr * expr)
}
-/* Return the offset for an index. Performs bound checking for elemental
- dimensions. Single element references are processed separately.
- DIM is the array dimension, I is the loop dimension. */
-
-static tree
-conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i,
- gfc_array_ref * ar, tree stride)
-{
- gfc_array_info *info;
- tree index;
- tree desc;
- tree data;
-
- info = &ss->info->data.array;
-
- /* Get the index into the array for this dimension. */
- if (ar)
- {
- gcc_assert (ar->type != AR_ELEMENT);
- switch (ar->dimen_type[dim])
- {
- case DIMEN_THIS_IMAGE:
- gcc_unreachable ();
- break;
- case DIMEN_ELEMENT:
- /* Elemental dimension. */
- gcc_assert (info->subscript[dim]
- && info->subscript[dim]->info->type == GFC_SS_SCALAR);
- /* We've already translated this value outside the loop. */
- index = info->subscript[dim]->info->data.scalar.value;
-
- index = trans_array_bound_check (se, ss, index, dim, &ar->where,
- ar->as->type != AS_ASSUMED_SIZE
- || dim < ar->dimen - 1);
- break;
-
- case DIMEN_VECTOR:
- gcc_assert (info && se->loop);
- gcc_assert (info->subscript[dim]
- && info->subscript[dim]->info->type == GFC_SS_VECTOR);
- desc = info->subscript[dim]->info->data.array.descriptor;
-
- /* Get a zero-based index into the vector. */
- index = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- se->loop->loopvar[i], se->loop->from[i]);
-
- /* Multiply the index by the stride. */
- index = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type,
- index, gfc_conv_array_stride (desc, 0));
-
- /* Read the vector to get an index into info->descriptor. */
- data = build_fold_indirect_ref_loc (input_location,
- gfc_conv_array_data (desc));
- index = gfc_build_array_ref (data, index, NULL);
- index = gfc_evaluate_now (index, &se->pre);
- index = fold_convert (gfc_array_index_type, index);
-
- /* Do any bounds checking on the final info->descriptor index. */
- index = trans_array_bound_check (se, ss, index, dim, &ar->where,
- ar->as->type != AS_ASSUMED_SIZE
- || dim < ar->dimen - 1);
- break;
-
- case DIMEN_RANGE:
- /* Scalarized dimension. */
- gcc_assert (info && se->loop);
-
- /* Multiply the loop variable by the stride and delta. */
- index = se->loop->loopvar[i];
- if (!integer_onep (info->stride[dim]))
- index = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, index,
- info->stride[dim]);
- if (!integer_zerop (info->delta[dim]))
- index = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type, index,
- info->delta[dim]);
- break;
-
- default:
- gcc_unreachable ();
- }
- }
- else
- {
- /* Temporary array or derived type component. */
- gcc_assert (se->loop);
- index = se->loop->loopvar[se->loop->order[i]];
-
- /* Pointer functions can have stride[0] different from unity.
- Use the stride returned by the function call and stored in
- the descriptor for the temporary. */
- if (se->ss && se->ss->info->type == GFC_SS_FUNCTION
- && se->ss->info->expr
- && se->ss->info->expr->symtree
- && se->ss->info->expr->symtree->n.sym->result
- && se->ss->info->expr->symtree->n.sym->result->attr.pointer)
- stride = gfc_conv_descriptor_stride_get (info->descriptor,
- gfc_rank_cst[dim]);
-
- if (info->delta[dim] && !integer_zerop (info->delta[dim]))
- index = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type, index, info->delta[dim]);
- }
-
- /* Multiply by the stride. */
- if (stride != NULL && !integer_onep (stride))
- index = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- index, stride);
-
- return index;
-}
-
-
/* Build a scalarized array reference using the vptr 'size'. */
static bool
@@ -3532,6 +3465,155 @@ non_negative_strides_array_p (tree expr)
}
+static tree
+build_array_ref (tree desc, tree offset, tree decl, tree vptr)
+{
+ 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);
+ tmp = build_fold_indirect_ref_loc (input_location, tmp);
+ tmp = gfc_build_array_ref (tmp, offset, decl,
+ non_negative_strides_array_p (desc),
+ vptr);
+ return tmp;
+}
+
+
+/* Return the offset for an index. Performs bound checking for elemental
+ dimensions. Single element references are processed separately.
+ DIM is the array dimension, I is the loop dimension. */
+
+static tree
+conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i,
+ gfc_array_ref * ar, tree spacing)
+{
+ gfc_array_info *info;
+ tree index;
+ tree data;
+ tree tmp;
+
+ info = &ss->info->data.array;
+
+ /* Get the index into the array for this dimension. */
+ if (ar)
+ {
+ gcc_assert (ar->type != AR_ELEMENT);
+ switch (ar->dimen_type[dim])
+ {
+ case DIMEN_THIS_IMAGE:
+ gcc_unreachable ();
+ break;
+ case DIMEN_ELEMENT:
+ /* Elemental dimension. */
+ gcc_assert (info->subscript[dim]
+ && info->subscript[dim]->info->type == GFC_SS_SCALAR);
+ /* We've already translated this value outside the loop. */
+ index = info->subscript[dim]->info->data.scalar.value;
+
+ index = trans_array_bound_check (se, ss, index, dim, &ar->where,
+ ar->as->type != AS_ASSUMED_SIZE
+ || dim < ar->dimen - 1);
+ break;
+
+ case DIMEN_VECTOR:
+ gcc_assert (info && se->loop);
+ gcc_assert (info->subscript[dim]
+ && info->subscript[dim]->info->type == GFC_SS_VECTOR);
+
+ /* Get a zero-based index into the vector. */
+ index = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ se->loop->loopvar[i], se->loop->from[i]);
+
+ /* Multiply the index by the stride. */
+ tmp = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, index,
+
info->subscript[dim]->info->data.array.spacing[0]);
+
+ data = info->subscript[dim]->info->data.array.data;
+ if (info->subscript[dim]->info->data.array.array_access)
+ index = fold_convert_loc (input_location, gfc_array_index_type,
tmp);
+ else
+ {
+ data = fold_build2_loc (input_location, POINTER_PLUS_EXPR,
+ TREE_TYPE (data), data, tmp);
+ index = gfc_index_zero_node;
+ }
+ /* Read the vector to get an index into info->descriptor. */
+ data = build_fold_indirect_ref_loc (input_location, data);
+ index = gfc_build_array_ref (data, index, NULL);
+ index = gfc_evaluate_now (index, &se->pre);
+ index = fold_convert (gfc_array_index_type, index);
+
+ /* Do any bounds checking on the final info->descriptor index. */
+ index = trans_array_bound_check (se, ss, index, dim, &ar->where,
+ ar->as->type != AS_ASSUMED_SIZE
+ || dim < ar->dimen - 1);
+ break;
+
+ case DIMEN_RANGE:
+ /* Scalarized dimension. */
+ gcc_assert (info && se->loop);
+
+ /* Multiply the loop variable by the stride and delta. */
+ index = se->loop->loopvar[i];
+ if (!integer_onep (info->stride[dim]))
+ index = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, index,
+ info->stride[dim]);
+ if (!integer_zerop (info->delta[dim]))
+ index = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type, index,
+ info->delta[dim]);
+ break;
+
+ default:
+ gcc_unreachable ();
+ }
+ }
+ else
+ {
+ /* Temporary array or derived type component. */
+ gcc_assert (se->loop);
+ index = se->loop->loopvar[se->loop->order[i]];
+
+ if (info->delta[dim] && !integer_zerop (info->delta[dim]))
+ index = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type, index, info->delta[dim]);
+ }
+
+ /* Multiply by the spacing. */
+ if (spacing != NULL && !integer_onep (spacing))
+ return fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ index, spacing);
+ else
+ return index;
+}
+
+
/* Build a scalarized reference to an array. */
static void
@@ -3540,7 +3622,6 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref
* ar,
{
gfc_array_info *info;
tree decl = NULL_TREE;
- tree index;
tree base;
gfc_ss *ss;
gfc_expr *expr;
@@ -3554,14 +3635,33 @@ gfc_conv_scalarized_array_ref (gfc_se * se,
gfc_array_ref * ar,
else
n = 0;
- index = conv_array_index_offset (se, ss, ss->dim[n], n, ar, info->stride0);
- /* Add the offset for this dimension to the stored offset for all other
- dimensions. */
- if (info->offset && !integer_zerop (info->offset))
- index = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
- index, info->offset);
+ tree tmp = conv_array_index_offset (se, ss, ss->dim[n], n, ar,
+ info->spacing[ss->dim[n]]);
+ tree index, data;
+ if (info->array_access)
+ {
+ index = tmp;
+
+ /* Add the offset for this dimension to the stored offset for all other
+ dimensions. */
+ if (info->offset && !integer_zerop (info->offset))
+ index = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type,
+ index, info->offset);
+
+ data = info->data;
+ }
+ else
+ {
+ tree offset = fold_convert (size_type_node, tmp);
+
+ data = info->data;
+ data = fold_build2_loc (input_location, POINTER_PLUS_EXPR, TREE_TYPE
(data),
+ data, offset);
+
+ index = gfc_index_zero_node;
+ }
- base = build_fold_indirect_ref_loc (input_location, info->data);
+ base = build_fold_indirect_ref_loc (input_location, data);
/* Use the vptr 'size' field to access the element of a class array. */
if (build_class_array_ref (se, base, index))
@@ -3621,43 +3721,6 @@ add_to_offset (tree *cst_offset, tree *offset, tree t)
}
-static tree
-build_array_ref (tree desc, tree offset, tree decl, tree vptr)
-{
- 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);
- tmp = build_fold_indirect_ref_loc (input_location, tmp);
- tmp = gfc_build_array_ref (tmp, offset, decl,
- non_negative_strides_array_p (desc),
- vptr);
- return tmp;
-}
-
-
/* Build an array reference. se->expr already holds the array descriptor.
This should be either a variable, indirect variable reference or component
reference. For arrays which do not have a descriptor, se->expr will be
@@ -3671,7 +3734,6 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar,
gfc_expr *expr,
int n;
tree offset, cst_offset;
tree tmp;
- tree stride;
tree decl = NULL_TREE;
gfc_se indexse;
gfc_se tmpse;
@@ -3727,8 +3789,21 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar,
gfc_expr *expr,
&& ar->as->type != AS_DEFERRED)
decl = sym->backend_decl;
+ bool use_array_ref = array_access_safe_p (expr);
+ tree elem_len = NULL_TREE;
+ if (use_array_ref)
+ {
+ elem_len = gfc_get_array_span (decl, expr);
+ elem_len = fold_convert_loc (input_location, gfc_array_index_type,
+ elem_len);
+ }
+
cst_offset = offset = gfc_index_zero_node;
- add_to_offset (&cst_offset, &offset, gfc_conv_array_offset (decl));
+ tmp = gfc_conv_array_offset (decl);
+ if (use_array_ref)
+ tmp = fold_build2_loc (input_location, EXACT_DIV_EXPR,
+ gfc_array_index_type, tmp, elem_len);
+ add_to_offset (&cst_offset, &offset, tmp);
/* Calculate the offsets from all the dimensions. Make sure to associate
the final offset so that we form a chain of loop invariant summands. */
@@ -3795,10 +3870,14 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar,
gfc_expr *expr,
}
}
- /* Multiply the index by the stride. */
- stride = gfc_conv_array_stride (decl, n);
+ /* Multiply the index by the sm. */
+ tree tmp = gfc_conv_array_sm (decl, n);
+ if (use_array_ref)
+ tmp = fold_build2_loc (input_location, EXACT_DIV_EXPR,
+ gfc_array_index_type, tmp, elem_len);
+
tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- indexse.expr, stride);
+ indexse.expr, tmp);
/* And add it to the total. */
add_to_offset (&cst_offset, &offset, tmp);
@@ -3854,7 +3933,15 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar,
gfc_expr *expr,
}
free (var_name);
- se->expr = build_array_ref (se->expr, offset, decl, se->class_vptr);
+ if (use_array_ref)
+ se->expr = build_array_ref (se->expr, offset, decl, se->class_vptr);
+ else
+ {
+ offset = fold_convert_loc (input_location, size_type_node, offset);
+ tree ptr = fold_build2_loc (input_location, POINTER_PLUS_EXPR,
+ TREE_TYPE (se->expr), se->expr, offset);
+ se->expr = build_array_ref (ptr, gfc_array_index_type, decl, NULL_TREE);
+ }
}
@@ -3867,21 +3954,34 @@ add_array_offset (stmtblock_t *pblock, gfc_loopinfo
*loop, gfc_ss *ss,
{
gfc_se se;
gfc_array_info *info;
- tree stride, index;
info = &ss->info->data.array;
gfc_init_se (&se, NULL);
se.loop = loop;
se.expr = info->descriptor;
- stride = gfc_conv_array_stride (info->descriptor, array_dim);
- index = conv_array_index_offset (&se, ss, array_dim, loop_dim, ar, stride);
+ tree tmp = conv_array_index_offset (&se, ss, array_dim, loop_dim, ar,
+ info->spacing[array_dim]);
gfc_add_block_to_block (pblock, &se.pre);
- info->offset = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type,
- info->offset, index);
- info->offset = gfc_evaluate_now (info->offset, pblock);
+ if (info->array_access)
+ {
+ tree index = fold_convert_loc (input_location, gfc_array_index_type,
tmp);
+
+ info->offset = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type,
+ info->offset, index);
+ info->offset = gfc_evaluate_now (info->offset, pblock);
+ }
+ else
+ {
+ tree offset = fold_convert_loc (input_location, size_type_node, tmp);
+
+ info->data = fold_build2_loc (input_location, POINTER_PLUS_EXPR,
+ TREE_TYPE (info->data),
+ info->data, offset);
+ info->data = gfc_evaluate_now (info->data, pblock);
+ }
}
@@ -3892,7 +3992,6 @@ static void
gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
stmtblock_t * pblock)
{
- tree stride;
gfc_ss_info *ss_info;
gfc_array_info *info;
gfc_ss_type ss_type;
@@ -3948,14 +4047,6 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim,
int flag,
{
gcc_assert (0 == ploop->order[0]);
- stride = gfc_conv_array_stride (info->descriptor,
- innermost_ss (ss)->dim[0]);
-
- /* Calculate the stride of the innermost loop. Hopefully this will
- allow the backend optimizers to do their stuff more effectively.
- */
- info->stride0 = gfc_evaluate_now (stride, pblock);
-
/* For the outermost loop calculate the offset due to any
elemental dimensions. It will have been initialized with the
base offset of the array. */
@@ -3989,7 +4080,10 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim,
int flag,
/* Remember this offset for the second loop. */
if (dim == loop->temp_dim - 1 && loop->parent == NULL)
- info->saved_offset = info->offset;
+ {
+ info->saved_offset = info->offset;
+ info->saved_data = info->data;
+ }
}
}
@@ -4219,6 +4313,7 @@ gfc_trans_scalarized_loop_boundary (gfc_loopinfo * loop,
stmtblock_t * body)
continue;
ss_info->data.array.offset = ss_info->data.array.saved_offset;
+ ss_info->data.array.data = ss_info->data.array.saved_data;
}
/* Restart all the inner loops we just finished. */
@@ -4283,6 +4378,51 @@ evaluate_bound (stmtblock_t *block, tree *bounds,
gfc_expr ** values,
}
+static void
+conv_array_spacing (stmtblock_t * block, gfc_ss * ss, int dim)
+{
+ gfc_array_info *info;
+
+ gcc_assert (ss->info->type == GFC_SS_SECTION);
+
+ info = &ss->info->data.array;
+ tree desc = info->descriptor;
+
+ bool save_value = !ss->is_alloc_lhs;
+
+ tree value = NULL_TREE;
+
+ if (info->array_access)
+ {
+ tree type = TREE_TYPE (desc);
+ if (GFC_ARRAY_TYPE_P (type)
+ && GFC_TYPE_ARRAY_STRIDE (type, dim) != NULL_TREE)
+ value = GFC_TYPE_ARRAY_STRIDE (type, dim);
+ else if (dim == 0)
+ value = gfc_index_one_node;
+ else
+ {
+ if (info->spacing[dim - 1] == NULL_TREE)
+ conv_array_spacing (block, ss, dim - 1);
+
+ tree previous_spacing = info->spacing[dim - 1];
+ tree previous_extent = gfc_conv_array_extent (desc, dim - 1);
+ value = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, previous_spacing,
+ previous_extent);
+ }
+ }
+ else
+ value = gfc_conv_descriptor_sm_get (info->descriptor,
+ gfc_rank_cst[dim]);
+
+ if (save_value)
+ info->spacing[dim] = gfc_evaluate_now (value, block);
+ else
+ info->spacing[dim] = value;
+}
+
+
/* Calculate the lower bound of an array section. */
static void
@@ -4591,7 +4731,10 @@ done:
!loop->array_parameter);
for (n = 0; n < ss->dimen; n++)
- gfc_conv_section_startstride (&outer_loop->pre, ss, ss->dim[n]);
+ {
+ gfc_conv_section_startstride (&outer_loop->pre, ss, ss->dim[n]);
+ conv_array_spacing (&outer_loop->pre, ss, ss->dim[n]);
+ }
break;
case GFC_SS_INTRINSIC:
@@ -4609,6 +4752,7 @@ done:
gfc_add_block_to_block (&outer_loop->post, &se.post);
info->descriptor = se.expr;
+ info->array_access = true;
info->data = gfc_conv_array_data (info->descriptor);
info->data = gfc_evaluate_now (info->data, &outer_loop->pre);
@@ -6187,7 +6331,7 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree
* poffset,
{
gfc_array_spec *as;
tree size;
- tree stride;
+ tree sm;
tree offset;
tree ubound;
tree lbound;
@@ -6200,9 +6344,12 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym,
tree * poffset,
size = gfc_index_one_node;
offset = gfc_index_zero_node;
- stride = GFC_TYPE_ARRAY_STRIDE (type, 0);
- if (stride && VAR_P (stride))
- gfc_add_modify (pblock, stride, gfc_index_one_node);
+ sm = GFC_TYPE_ARRAY_SM (type, 0);
+ if (sm && VAR_P (sm))
+ {
+ tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
+ gfc_add_modify (pblock, sm, tmp);
+ }
for (dim = 0; dim < as->rank; dim++)
{
/* Evaluate non-constant array bound expressions.
@@ -6228,7 +6375,7 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree
* poffset,
gfc_add_block_to_block (pblock, &se.finalblock);
gfc_add_modify (pblock, ubound, se.expr);
}
- /* The offset of this dimension. offset = offset - lbound * stride. */
+ /* The offset of this dimension. offset = offset - lbound * sm. */
tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
lbound, size);
offset = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
@@ -6236,13 +6383,13 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym,
tree * poffset,
/* The size of this dimension, and the stride of the next. */
if (dim + 1 < as->rank)
- stride = GFC_TYPE_ARRAY_STRIDE (type, dim + 1);
+ sm = GFC_TYPE_ARRAY_SM (type, dim + 1);
else
- stride = GFC_TYPE_ARRAY_SIZE (type);
+ sm = GFC_TYPE_ARRAY_SIZE (type);
- if (ubound != NULL_TREE && !(stride && INTEGER_CST_P (stride)))
+ if (ubound != NULL_TREE && !(sm && INTEGER_CST_P (sm)))
{
- /* Calculate stride = size * (ubound + 1 - lbound). */
+ /* Calculate sm = size * (ubound + 1 - lbound). */
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
gfc_index_one_node, lbound);
@@ -6250,22 +6397,22 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym,
tree * poffset,
gfc_array_index_type, ubound, tmp);
tmp = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type, size, tmp);
- if (stride)
- gfc_add_modify (pblock, stride, tmp);
+ if (sm)
+ gfc_add_modify (pblock, sm, tmp);
else
- stride = gfc_evaluate_now (tmp, pblock);
+ sm = gfc_evaluate_now (tmp, pblock);
/* Make sure that negative size arrays are translated
to being zero size. */
tmp = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
- stride, gfc_index_zero_node);
+ sm, gfc_index_zero_node);
tmp = fold_build3_loc (input_location, COND_EXPR,
gfc_array_index_type, tmp,
- stride, gfc_index_zero_node);
- gfc_add_modify (pblock, stride, tmp);
+ sm, gfc_index_zero_node);
+ gfc_add_modify (pblock, sm, tmp);
}
- size = stride;
+ size = sm;
}
gfc_trans_array_cobounds (type, pblock, sym);
@@ -6526,7 +6673,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree
tmpdesc,
tree dextent;
tree dumdesc;
tree tmp;
- tree stride, stride2;
+ tree stride2, sm;
tree stmt_packed;
tree stmt_unpacked;
tree partial;
@@ -6587,9 +6734,9 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree
tmpdesc,
anything as we still don't know the array stride. */
partial = gfc_create_var (logical_type_node, "partial");
TREE_USED (partial) = 1;
- tmp = gfc_conv_descriptor_stride_get (dumdesc, gfc_rank_cst[0]);
+ tmp = gfc_conv_descriptor_sm_get (dumdesc, gfc_rank_cst[0]);
tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, tmp,
- gfc_index_one_node);
+ gfc_conv_descriptor_span_get (dumdesc));
gfc_add_modify (&init, partial, tmp);
}
else
@@ -6600,28 +6747,23 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree
tmpdesc,
if (no_repack)
{
/* Set the first stride. */
- stride = gfc_conv_descriptor_stride_get (dumdesc, gfc_rank_cst[0]);
- stride = gfc_evaluate_now (stride, &init);
-
- tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
- stride, gfc_index_zero_node);
- tmp = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type,
- tmp, gfc_index_one_node, stride);
- stride = GFC_TYPE_ARRAY_STRIDE (type, 0);
- gfc_add_modify (&init, stride, tmp);
+ sm = gfc_conv_descriptor_sm_get (dumdesc, gfc_rank_cst[0]);
+ tmp = gfc_evaluate_now (sm, &init);
+ sm = GFC_TYPE_ARRAY_SM (type, 0);
+ gfc_add_modify (&init, sm, tmp);
/* Allow the user to disable array repacking. */
stmt_unpacked = NULL_TREE;
}
else
{
- gcc_assert (integer_onep (GFC_TYPE_ARRAY_STRIDE (type, 0)));
+ gcc_assert (GFC_TYPE_ARRAY_SM (type, 0) == GFC_TYPE_ARRAY_ELEM_LEN
(type));
/* A library call to repack the array if necessary. */
tmp = GFC_DECL_SAVED_DESCRIPTOR (tmpdesc);
stmt_unpacked = build_call_expr_loc (input_location,
gfor_fndecl_in_pack, 1, tmp);
- stride = gfc_index_one_node;
+ sm = GFC_TYPE_ARRAY_ELEM_LEN (type);
if (warn_array_temporaries)
{
@@ -6672,6 +6814,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree
tmpdesc,
gfc_add_modify (&init, lbound, se.expr);
}
+ tree extent = GFC_TYPE_ARRAY_EXTENT (type, n);
ubound = GFC_TYPE_ARRAY_UBOUND (type, n);
/* Set the desired upper bound. */
if (as->upper[n])
@@ -6695,11 +6838,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree
tmpdesc,
locus where;
gfc_locus_from_location (&where, loc);
- temp = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type, ubound, lbound);
- temp = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type,
- gfc_index_one_node, temp);
+ temp = extent;
stride2 = dextent;
tmp = fold_build2_loc (input_location, NE_EXPR,
gfc_array_index_type, temp, stride2);
@@ -6724,66 +6863,42 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree
tmpdesc,
gfc_array_index_type, tmp, lbound);
gfc_add_modify (&init, ubound, tmp);
}
- /* The offset of this dimension. offset = offset - lbound * stride. */
+ /* The offset of this dimension. offset = offset - lbound * sm. */
tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- lbound, stride);
+ lbound, sm);
offset = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, offset, tmp);
- /* The size of this dimension, and the stride of the next. */
+ /* The size of this dimension, and the sm of the next. */
if (n + 1 < as->rank)
{
- stride = GFC_TYPE_ARRAY_STRIDE (type, n + 1);
+ sm = GFC_TYPE_ARRAY_SM (type, n + 1);
if (no_repack || partial != NULL_TREE)
stmt_unpacked =
- gfc_conv_descriptor_stride_get (dumdesc, gfc_rank_cst[n+1]);
+ gfc_conv_descriptor_sm_get (dumdesc, gfc_rank_cst[n+1]);
- /* Figure out the stride if not a known constant. */
- if (!INTEGER_CST_P (stride))
+ /* Figure out the sm if not a known constant. */
+ if (!INTEGER_CST_P (sm))
{
if (no_repack)
stmt_packed = NULL_TREE;
else
{
- /* Calculate stride = size * (ubound + 1 - lbound). */
- tmp = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- gfc_index_one_node, lbound);
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type, ubound, tmp);
+ /* Calculate sm = size * (ubound + 1 - lbound). */
size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size, tmp);
+ gfc_array_index_type, size, extent);
stmt_packed = size;
}
- /* Assign the stride. */
+ /* Assign the sm. */
if (stmt_packed != NULL_TREE && stmt_unpacked != NULL_TREE)
tmp = fold_build3_loc (input_location, COND_EXPR,
gfc_array_index_type, partial,
stmt_unpacked, stmt_packed);
else
tmp = (stmt_packed != NULL_TREE) ? stmt_packed : stmt_unpacked;
- gfc_add_modify (&init, stride, tmp);
- }
- }
- else
- {
- stride = GFC_TYPE_ARRAY_SIZE (type);
-
- if (stride && !INTEGER_CST_P (stride))
- {
- /* Calculate size = stride * (ubound + 1 - lbound). */
- tmp = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- gfc_index_one_node, lbound);
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type,
- ubound, tmp);
- tmp = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type,
- GFC_TYPE_ARRAY_STRIDE (type, n), tmp);
- gfc_add_modify (&init, stride, tmp);
+ gfc_add_modify (&init, sm, tmp);
}
}
}
@@ -8443,15 +8558,26 @@ gfc_full_array_size (stmtblock_t *block, tree decl, int
rank)
tree nelems;
tree tmp;
if (rank < 0)
- idx = gfc_conv_descriptor_rank_get (decl);
+ {
+ idx = gfc_conv_descriptor_rank_get (decl);
+ tmp = gfc_conv_descriptor_extent_get (decl, idx);
+ tmp = gfc_evaluate_now (tmp, block);
+
+ nelems = gfc_conv_descriptor_stride_get (decl, idx);
+ tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ nelems, tmp);
+ }
else
- idx = gfc_rank_cst[rank - 1];
- tmp = gfc_conv_descriptor_extent_get (decl, idx);
- tmp = gfc_evaluate_now (tmp, block);
+ {
+ tmp = gfc_index_one_node;
+ for (int i = 0; i < rank; i++)
+ {
+ tree extent = gfc_conv_descriptor_extent_get (decl, gfc_rank_cst[i]);
+ tmp = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, tmp, extent);
- nelems = gfc_conv_descriptor_stride_get (decl, idx);
- tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- nelems, tmp);
+ }
+ }
return gfc_evaluate_now (tmp, block);
}
@@ -10189,8 +10315,8 @@ update_reallocated_descriptor (stmtblock_t *block,
gfc_loopinfo *loop)
gfc_conv_descriptor_lbound_get (desc, tree_dim));
UPDATE_VALUE (info->end[dim],
gfc_conv_descriptor_ubound_get (desc, tree_dim));
- UPDATE_VALUE (info->stride[dim],
- gfc_conv_descriptor_stride_get (desc, tree_dim));
+ UPDATE_VALUE (info->spacing[dim],
+ gfc_conv_descriptor_sm_get (desc, tree_dim));
info->delta[dim] = gfc_evaluate_now (info->delta[dim], block);
}
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 3baf579300bb..709166f07551 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -161,9 +161,10 @@ void gfc_conv_array_parameter (gfc_se *, gfc_expr *, bool,
const gfc_symbol *,
tree gfc_conv_array_data (tree);
tree gfc_conv_array_offset (tree);
/* Return either an INT_CST or an expression for that part of the descriptor.
*/
-tree gfc_conv_array_stride (tree, int);
+tree gfc_conv_array_sm (tree, int);
tree gfc_conv_array_lbound (tree, int);
tree gfc_conv_array_ubound (tree, int);
+tree gfc_conv_array_extent (tree, int);
/* Set (co)bounds of an array. */
tree gfc_trans_array_bounds (tree, gfc_symbol *, tree *, stmtblock_t *);
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index d88ad3655c19..1e92b8c63925 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -1128,10 +1128,10 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
suppress_warning (GFC_TYPE_ARRAY_UBOUND (type, dim));
}
- if (GFC_TYPE_ARRAY_STRIDE (type, dim) == NULL_TREE)
+ if (GFC_TYPE_ARRAY_SM (type, dim) == NULL_TREE)
{
- GFC_TYPE_ARRAY_STRIDE (type, dim) = create_index_var ("stride", nest);
- suppress_warning (GFC_TYPE_ARRAY_STRIDE (type, dim));
+ GFC_TYPE_ARRAY_SM (type, dim) = create_index_var ("sm", nest);
+ suppress_warning (GFC_TYPE_ARRAY_SM (type, dim));
}
}
for (dim = GFC_TYPE_ARRAY_RANK (type);
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 7e709609435c..e5c1eb5b3835 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -168,7 +168,7 @@ gfc_get_cfi_dim_sm (tree desc, tree idx)
#define DIMENSION_FIELD 4
#define CAF_TOKEN_FIELD 5
-#define STRIDE_SUBFIELD 0
+#define SM_SUBFIELD 0
#define LBOUND_SUBFIELD 1
#define UBOUND_SUBFIELD 2
@@ -573,15 +573,15 @@ get_subfield (tree desc, tree dim, unsigned field_idx)
}
tree
-get_stride (tree desc, tree dim)
+get_sm (tree desc, tree dim)
{
- tree field = get_subfield (desc, dim, STRIDE_SUBFIELD);
+ tree field = get_subfield (desc, dim, SM_SUBFIELD);
gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
return field;
}
tree
-conv_stride_get (tree desc, tree dim)
+conv_sm_get (tree desc, tree dim)
{
tree type = TREE_TYPE (desc);
gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
@@ -592,20 +592,40 @@ conv_stride_get (tree desc, tree dim)
|| GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_ALLOCATABLE
|| GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_POINTER_CONT
|| GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT))
- return gfc_index_one_node;
+ return conv_span_get (desc);
- return non_lvalue_loc (input_location, get_stride (desc, dim));
+ return non_lvalue_loc (input_location, get_sm (desc, dim));
}
void
-conv_stride_set (stmtblock_t *block, tree desc, tree dim, tree value)
+conv_sm_set (stmtblock_t *block, tree desc, tree dim, tree value)
{
location_t loc = input_location;
- tree t = get_stride (desc, dim);
+ tree t = get_sm (desc, dim);
gfc_add_modify_loc (loc, block, t,
fold_convert_loc (loc, TREE_TYPE (t), value));
}
+tree
+conv_stride_get (tree desc, tree dim)
+{
+ tree type = TREE_TYPE (desc);
+ gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+ if (integer_zerop (dim)
+ && (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE
+ || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_SHAPE_CONT
+ || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_CONT
+ || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_ALLOCATABLE
+ || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_POINTER_CONT
+ || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT))
+ return gfc_index_one_node;
+
+ tree sm = conv_sm_get (desc, dim);
+ tree span = conv_span_get (desc);
+ return fold_build2_loc (input_location, EXACT_DIV_EXPR, gfc_array_index_type,
+ sm, span);
+}
+
tree
get_lbound (tree desc, tree dim)
{
@@ -844,16 +864,16 @@ gfc_conv_descriptor_token_set (stmtblock_t *block, tree
desc, tree value)
}
tree
-gfc_conv_descriptor_stride_get (tree desc, tree dim)
+gfc_conv_descriptor_sm_get (tree desc, tree dim)
{
- return gfc_descriptor::conv_stride_get (desc, dim);
+ return gfc_descriptor::conv_sm_get (desc, dim);
}
void
-gfc_conv_descriptor_stride_set (stmtblock_t *block, tree desc,
+gfc_conv_descriptor_sm_set (stmtblock_t *block, tree desc,
tree dim, tree value)
{
- gfc_descriptor::conv_stride_set (block, desc, dim, value);
+ gfc_descriptor::conv_sm_set (block, desc, dim, value);
}
tree
@@ -929,13 +949,9 @@ gfc_conv_descriptor_extent_get (tree desc, tree dim)
tree
-gfc_conv_descriptor_sm_get (tree desc, tree dim)
+gfc_conv_descriptor_stride_get (tree desc, tree dim)
{
- tree stride = gfc_conv_descriptor_stride_get (desc, dim);
- tree span = gfc_conv_descriptor_span_get (desc);
-
- return fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- stride, span);
+ return gfc_descriptor::conv_stride_get (desc, dim);
}
@@ -1942,8 +1958,8 @@ gfc_build_null_descriptor (tree type)
static void
set_bounds_update_offset (stmtblock_t *block, tree desc, int dim,
- tree lbound, tree ubound, tree stride, tree
lbound_diff,
- tree *offset, tree *next_stride, bool
stride_unchanged)
+ tree lbound, tree ubound, tree sm, tree lbound_diff,
+ tree *offset, tree *next_sm, bool sm_unchanged)
{
/* Stabilize values in case the expressions depend on the existing bounds.
*/
lbound = fold_convert (gfc_array_index_type, lbound);
@@ -1952,8 +1968,8 @@ set_bounds_update_offset (stmtblock_t *block, tree desc,
int dim,
ubound = fold_convert (gfc_array_index_type, ubound);
ubound = gfc_evaluate_now (ubound, block);
- stride = fold_convert (gfc_array_index_type, stride);
- stride = gfc_evaluate_now (stride, block);
+ sm = fold_convert (gfc_array_index_type, sm);
+ sm = gfc_evaluate_now (sm, block);
lbound_diff = fold_convert (gfc_array_index_type, lbound_diff);
lbound_diff = gfc_evaluate_now (lbound_diff, block);
@@ -1962,40 +1978,40 @@ set_bounds_update_offset (stmtblock_t *block, tree
desc, int dim,
gfc_rank_cst[dim], lbound);
gfc_conv_descriptor_ubound_set (block, desc,
gfc_rank_cst[dim], ubound);
- if (!stride_unchanged)
- gfc_conv_descriptor_stride_set (block, desc,
- gfc_rank_cst[dim], stride);
+ if (!sm_unchanged)
+ gfc_conv_descriptor_sm_set (block, desc,
+ gfc_rank_cst[dim], sm);
- if (!offset && !next_stride)
+ if (!offset && !next_sm)
return;
/* Update offset. */
if (!integer_zerop (lbound_diff))
{
tree tmp = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, lbound_diff, stride);
+ gfc_array_index_type, lbound_diff, sm);
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, *offset, tmp);
*offset = gfc_evaluate_now (tmp, block);
}
- if (!next_stride)
+ if (!next_sm)
return;
- /* Set stride for next dimension. */
+ /* Set sm for next dimension. */
tree tmp = gfc_conv_array_extent_dim (lbound, ubound, NULL);
- *next_stride = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, stride, tmp);
+ *next_sm = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, sm, tmp);
}
static void
set_descriptor_dimension (stmtblock_t *block, tree desc, int dim,
- tree lbound, tree ubound, tree stride, tree *offset,
- tree *next_stride)
+ tree lbound, tree ubound, tree sm, tree *offset,
+ tree *next_sm)
{
- set_bounds_update_offset (block, desc, dim, lbound, ubound, stride, lbound,
- offset, next_stride, false);
+ set_bounds_update_offset (block, desc, dim, lbound, ubound, sm, lbound,
+ offset, next_sm, false);
}
@@ -2011,7 +2027,7 @@ conv_shift_descriptor_lbound (stmtblock_t* block, tree
from_desc, tree to_desc,
tree lbound = gfc_conv_descriptor_lbound_get (from_desc, gfc_rank_cst[dim]);
tree ubound = gfc_conv_descriptor_ubound_get (from_desc, gfc_rank_cst[dim]);
- tree stride = gfc_conv_descriptor_stride_get (from_desc, gfc_rank_cst[dim]);
+ tree sm = gfc_conv_descriptor_sm_get (from_desc, gfc_rank_cst[dim]);
tree diff;
if (zero_based)
@@ -2029,7 +2045,7 @@ conv_shift_descriptor_lbound (stmtblock_t* block, tree
from_desc, tree to_desc,
tree tmp1 = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
ubound, diff);
- set_bounds_update_offset (block, to_desc, dim, new_lbound, tmp1, stride,
diff,
+ set_bounds_update_offset (block, to_desc, dim, new_lbound, tmp1, sm, diff,
offset, nullptr, from_desc == to_desc);
}
@@ -2385,13 +2401,10 @@ gfc_conv_remap_descriptor (stmtblock_t *block, tree
dest, tree src,
tree offs = gfc_conv_descriptor_offset_get (src);
for (int dim = 0; dim < src_rank; ++dim)
{
- tree stride = gfc_conv_descriptor_stride_get (src,
- gfc_rank_cst[dim]);
- tree lbound = gfc_conv_descriptor_lbound_get (src,
- gfc_rank_cst[dim]);
+ tree sm = gfc_conv_descriptor_sm_get (src, gfc_rank_cst[dim]);
+ tree lbound = gfc_conv_descriptor_lbound_get (src, gfc_rank_cst[dim]);
tmp = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, stride,
- lbound);
+ gfc_array_index_type, sm, lbound);
offs = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type, offs, tmp);
}
@@ -2399,7 +2412,7 @@ gfc_conv_remap_descriptor (stmtblock_t *block, tree dest,
tree src,
}
/* Set the bounds as declared for the LHS and calculate strides as
well as another offset update accordingly. */
- tree stride = gfc_conv_descriptor_stride_get (src, gfc_rank_cst[0]);
+ tree sm = gfc_conv_descriptor_sm_get (src, gfc_rank_cst[0]);
int last_dim = dest_rank - 1;
for (int dim = 0; dim < dest_rank; ++dim)
{
@@ -2418,8 +2431,8 @@ gfc_conv_remap_descriptor (stmtblock_t *block, tree dest,
tree src,
gfc_add_block_to_block (block, &upper_se.pre);
set_descriptor_dimension (block, dest, dim, lower_se.expr, upper_se.expr,
- stride, &offset,
- dim < last_dim ? &stride : nullptr);
+ sm, &offset,
+ dim < last_dim ? &sm : nullptr);
}
gfc_conv_descriptor_offset_set (block, dest, offset);
}
@@ -2485,12 +2498,12 @@ gfc_set_descriptor_with_shape (stmtblock_t *block, tree
desc,
locus *where)
{
/* Set the span field. */
- tree tmp = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc)));
- tmp = fold_convert (gfc_array_index_type, tmp);
- gfc_conv_descriptor_span_set (block, desc, tmp);
+ tree elem_len = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc)));
+ elem_len = fold_convert (gfc_array_index_type, elem_len);
+ gfc_conv_descriptor_span_set (block, desc, elem_len);
/* Set data value, dtype, and offset. */
- tmp = GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc));
+ tree tmp = GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc));
gfc_conv_descriptor_data_set (block, desc, fold_convert (tmp, ptr));
gfc_conv_descriptor_dtype_set (block, desc, gfc_get_dtype (TREE_TYPE
(desc)));
@@ -2511,9 +2524,9 @@ gfc_set_descriptor_with_shape (stmtblock_t *block, tree
desc,
gfc_copy_loopinfo_to_se (&shapese, &loop);
shapese.ss = shape_ss;
- tree stride = gfc_create_var (gfc_array_index_type, "stride");
+ tree sm = gfc_create_var (gfc_array_index_type, "sm");
tree offset = gfc_create_var (gfc_array_index_type, "offset");
- gfc_add_modify (block, stride, gfc_index_one_node);
+ gfc_add_modify (block, sm, elem_len);
gfc_add_modify (block, offset, gfc_index_zero_node);
/* Loop body. */
@@ -2523,9 +2536,9 @@ gfc_set_descriptor_with_shape (stmtblock_t *block, tree
desc,
tree dim = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
loop.loopvar[0], loop.from[0]);
- /* Set bounds and stride. */
+ /* Set bounds and sm. */
gfc_conv_descriptor_lbound_set (&body, desc, dim, gfc_index_one_node);
- gfc_conv_descriptor_stride_set (&body, desc, dim, stride);
+ gfc_conv_descriptor_sm_set (&body, desc, dim, sm);
gfc_conv_expr (&shapese, shape);
gfc_add_block_to_block (&body, &shapese.pre);
@@ -2535,11 +2548,11 @@ gfc_set_descriptor_with_shape (stmtblock_t *block, tree
desc,
/* Calculate offset. */
gfc_add_modify (&body, offset,
fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type, offset, stride));
- /* Update stride. */
- gfc_add_modify (&body, stride,
+ gfc_array_index_type, offset, sm));
+ /* Update sm. */
+ gfc_add_modify (&body, sm,
fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, stride,
+ gfc_array_index_type, sm,
fold_convert (gfc_array_index_type,
shapese.expr)));
/* Finish scalarization loop. */
@@ -2594,17 +2607,20 @@ gfc_copy_sequence_descriptor (stmtblock_t &block, tree
lhs_desc, tree rhs_desc,
gfc_conv_descriptor_lbound_set (&block, arr, gfc_index_zero_node,
gfc_index_zero_node);
tree size = gfc_conv_descriptor_size (rhs_desc, rhs_rank);
+ tree span = gfc_conv_descriptor_span_get (rhs_desc);
+ size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ size, span);
gfc_conv_descriptor_ubound_set (&block, arr, gfc_index_zero_node, size);
- gfc_conv_descriptor_stride_set (
+ gfc_conv_descriptor_sm_set (
&block, arr, gfc_index_zero_node,
- gfc_conv_descriptor_stride_get (rhs_desc, gfc_index_zero_node));
+ gfc_conv_descriptor_sm_get (rhs_desc, gfc_index_zero_node));
for (int i = 1; i < lhs_rank; i++)
{
gfc_conv_descriptor_lbound_set (&block, arr, gfc_rank_cst[i],
gfc_index_zero_node);
gfc_conv_descriptor_ubound_set (&block, arr, gfc_rank_cst[i],
gfc_index_zero_node);
- gfc_conv_descriptor_stride_set (&block, arr, gfc_rank_cst[i], size);
+ gfc_conv_descriptor_sm_set (&block, arr, gfc_rank_cst[i], size);
}
gfc_conv_descriptor_dtype_set (&block, arr,
gfc_conv_descriptor_dtype_get (rhs_desc));
@@ -2814,33 +2830,29 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
if (contiguous_gfc)
{
- /* gfc->dim[i].stride
- = idx == 0 ? 1 : gfc->dim[i-1].stride * cfi->dim[i-1].extent */
+ /* gfc->dim[i].sm
+ = idx == 0 ? cfi->elem_len : gfc->dim[i-1].stride *
cfi->dim[i-1].extent */
tree cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
idx, build_zero_cst (TREE_TYPE (idx)));
tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (idx),
idx, build_int_cst (TREE_TYPE (idx), 1));
tree tmp2 = gfc_get_cfi_dim_extent (cfi, tmp);
- tmp = gfc_conv_descriptor_stride_get (gfc, tmp);
+ tmp = gfc_conv_descriptor_sm_get (gfc, tmp);
tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp2),
tmp2, tmp);
tmp = build3_loc (input_location, COND_EXPR, gfc_array_index_type, cond,
- gfc_index_one_node, tmp);
+ gfc_get_cfi_desc_elem_len (cfi), tmp);
}
else
{
/* gfc->dim[i].stride = cfi->dim[i].sm / cfi>elem_len */
tmp = gfc_get_cfi_dim_sm (cfi, idx);
- tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
- gfc_array_index_type, tmp,
- fold_convert (gfc_array_index_type,
- gfc_get_cfi_desc_elem_len (cfi)));
}
- gfc_conv_descriptor_stride_set (&loop_body, gfc, idx, tmp);
+ gfc_conv_descriptor_sm_set (&loop_body, gfc, idx, tmp);
/* gfc->offset -= gfc->dim[i].stride * gfc->dim[i].lbound. */
tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- gfc_conv_descriptor_stride_get (gfc, idx),
+ gfc_conv_descriptor_sm_get (gfc, idx),
gfc_conv_descriptor_lbound_get (gfc, idx));
tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
gfc_conv_descriptor_offset_get (gfc), tmp);
@@ -2858,7 +2870,7 @@ void
gfc_get_descriptor_offsets_for_info (const_tree desc_type, tree *data_off,
tree *dtype_off, tree *span_off,
tree *dim_off, tree *dim_size,
- tree *stride_suboff, tree *lower_suboff,
+ tree *sm_suboff, tree *lower_suboff,
tree *upper_suboff)
{
tree field;
@@ -2875,8 +2887,8 @@ gfc_get_descriptor_offsets_for_info (const_tree
desc_type, tree *data_off,
*dim_off = byte_position (field);
type = TREE_TYPE (TREE_TYPE (field));
*dim_size = TYPE_SIZE_UNIT (type);
- field = gfc_advance_chain (TYPE_FIELDS (type), STRIDE_SUBFIELD);
- *stride_suboff = byte_position (field);
+ field = gfc_advance_chain (TYPE_FIELDS (type), SM_SUBFIELD);
+ *sm_suboff = byte_position (field);
field = gfc_advance_chain (TYPE_FIELDS (type), LBOUND_SUBFIELD);
*lower_suboff = byte_position (field);
field = gfc_advance_chain (TYPE_FIELDS (type), UBOUND_SUBFIELD);
@@ -2901,7 +2913,7 @@ gfc_set_temporary_descriptor (stmtblock_t *block, tree
desc, tree class_src,
tree elemsize, tree data_ptr,
tree lbound[GFC_MAX_DIMENSIONS],
tree ubound[GFC_MAX_DIMENSIONS],
- tree stride[GFC_MAX_DIMENSIONS], int rank,
+ tree sm[GFC_MAX_DIMENSIONS], int rank,
bool omit_bounds, bool rank_changer,
bool shift_bounds)
{
@@ -2937,7 +2949,7 @@ gfc_set_temporary_descriptor (stmtblock_t *block, tree
desc, tree class_src,
/* Store the stride and bound components in the descriptor. */
tree this_lbound = shift_bounds ? gfc_index_zero_node : lbound[n];
set_descriptor_dimension (block, desc, n, this_lbound, ubound[n],
- stride[n], &offset, nullptr);
+ sm[n], &offset, nullptr);
}
}
@@ -3044,17 +3056,16 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree
src, gfc_expr *src_expr,
dtype = gfc_get_dtype (TREE_TYPE (src), &rank);
gfc_conv_descriptor_dtype_set (block, dest, dtype);
- /* The 1st element in the section. */
- tree base = gfc_index_zero_node;
- if (src_expr->ts.type == BT_CHARACTER && src_expr->rank == 0 && corank)
- base = gfc_index_one_node;
-
/* The offset from the 1st element in the section. */
tree offset = gfc_index_zero_node;
+ /* The 1st element in the section. */
+ if (src_expr->ts.type == BT_CHARACTER && src_expr->rank == 0 && corank)
+ offset = gfc_conv_descriptor_elem_len_get (dest);
+
for (int n = 0; n < ndim; n++)
{
- tree stride = gfc_conv_array_stride (src, n);
+ tree sm = gfc_conv_array_sm (src, n);
/* Work out the 1st element in the section. */
tree start;
@@ -3069,16 +3080,16 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree
src, gfc_expr *src_expr,
{
/* Evaluate and remember the start of the section. */
start = info->start[n];
- stride = gfc_evaluate_now (stride, block);
+ sm = gfc_evaluate_now (sm, block);
}
tmp = gfc_conv_array_lbound (src, n);
tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (tmp),
start, tmp);
tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp),
- tmp, stride);
- base = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (tmp),
- base, tmp);
+ tmp, sm);
+ offset = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (tmp),
+ offset, tmp);
if (info->ref
&& info->ref->u.ar.dimen_type[n] == DIMEN_ELEMENT)
@@ -3112,20 +3123,19 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree
src, gfc_expr *src_expr,
gfc_conv_descriptor_ubound_set (block, dest,
gfc_rank_cst[dim], to);
- /* Multiply the stride by the section stride to get the
+ /* Multiply the sm by the section stride to get the
total stride. */
- stride = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type,
- stride, info->stride[n]);
+ sm = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type,
+ sm, info->stride[n]);
tmp = fold_build2_loc (input_location, MULT_EXPR,
- TREE_TYPE (offset), stride, from);
+ TREE_TYPE (offset), sm, from);
offset = fold_build2_loc (input_location, MINUS_EXPR,
TREE_TYPE (offset), offset, tmp);
- /* Store the new stride. */
- gfc_conv_descriptor_stride_set (block, dest,
- gfc_rank_cst[dim], stride);
+ /* Store the new sm. */
+ gfc_conv_descriptor_sm_set (block, dest, gfc_rank_cst[dim], sm);
}
for (int n = rank; n < rank + corank; n++)
@@ -3141,7 +3151,7 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree
src, gfc_expr *src_expr,
if (data_needed)
/* Point the data pointer at the 1st element in the section. */
- gfc_get_dataptr_offset (block, dest, src, base,
+ gfc_get_dataptr_offset (block, dest, src, gfc_index_zero_node,
subref, src_expr);
else
gfc_conv_descriptor_data_set (block, dest,
@@ -3210,6 +3220,7 @@ gfc_descr_init_count (tree descriptor, int rank, int
corank, gfc_expr ** lower,
tree size;
tree offset;
tree stride;
+ tree sm;
tree cond;
gfc_expr *ubound;
gfc_se se;
@@ -3265,6 +3276,8 @@ gfc_descr_init_count (tree descriptor, int rank, int
corank, gfc_expr ** lower,
gfc_conv_descriptor_dtype_set (pblock, descriptor, gfc_get_dtype (type));
tree empty_cond = logical_false_node;
+ sm = gfc_conv_descriptor_elem_len_get (descriptor);
+ sm = fold_convert_loc (input_location, gfc_array_index_type, sm);
for (n = 0; n < rank; n++)
{
@@ -3313,7 +3326,7 @@ gfc_descr_init_count (tree descriptor, int rank, int
corank, gfc_expr ** lower,
/* Work out the offset for this component. */
tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- se.expr, stride);
+ se.expr, sm);
offset = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, offset, tmp);
@@ -3352,9 +3365,9 @@ gfc_descr_init_count (tree descriptor, int rank, int
corank, gfc_expr ** lower,
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);
+ /* Store the sm. */
+ gfc_conv_descriptor_sm_set (descriptor_block, descriptor,
+ gfc_rank_cst[n], sm);
/* Calculate size and check whether extent is negative. */
size = gfc_conv_array_extent_dim (conv_lbound, conv_ubound,
@@ -3372,7 +3385,7 @@ gfc_descr_init_count (tree descriptor, int rank, int
corank, gfc_expr ** lower,
TYPE_MAX_VALUE
(gfc_array_index_type)),
size);
cond = gfc_unlikely (fold_build2_loc (input_location, LT_EXPR,
- logical_type_node, tmp, stride),
+ logical_type_node, tmp, sm),
PRED_FORTRAN_OVERFLOW);
tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node,
cond,
integer_one_node, integer_zero_node);
@@ -3390,6 +3403,10 @@ gfc_descr_init_count (tree descriptor, int rank, int
corank, gfc_expr ** lower,
stride = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type, stride, size);
stride = gfc_evaluate_now (stride, pblock);
+
+ sm = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, sm, size);
+ sm = gfc_evaluate_now (sm, pblock);
}
for (n = rank; n < rank + corank; n++)
@@ -3483,9 +3500,9 @@ gfc_set_contiguous_array (stmtblock_t *block, tree desc,
tree size,
gfc_conv_descriptor_lbound_set (block, desc,
gfc_index_zero_node,
gfc_index_one_node);
- gfc_conv_descriptor_stride_set (block, desc,
- gfc_index_zero_node,
- gfc_index_one_node);
+ gfc_conv_descriptor_sm_set (block, desc,
+ gfc_index_zero_node,
+ gfc_conv_descriptor_span_get (desc));
gfc_conv_descriptor_ubound_set (block, desc,
gfc_index_zero_node, size);
gfc_conv_descriptor_data_set (block, desc, data_ptr);
@@ -3566,7 +3583,7 @@ gfc_copy_descriptor (stmtblock_t *block, tree dst, tree
src, int rank)
{
dim = gfc_rank_cst[n];
tmp = gfc_conv_descriptor_lbound_get (src, dim);
- tmp2 = gfc_conv_descriptor_stride_get (src, dim);
+ tmp2 = gfc_conv_descriptor_sm_get (src, dim);
tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp),
tmp, tmp2);
offset = fold_build2_loc (input_location, MINUS_EXPR,
@@ -3586,7 +3603,7 @@ get_std_lbound (gfc_expr *expr, tree desc, int dim, bool
assumed_size)
{
tree lbound;
tree ubound;
- tree stride;
+ tree sm;
tree cond, cond1, cond3, cond4;
tree tmp;
gfc_ref *ref;
@@ -3596,15 +3613,15 @@ get_std_lbound (gfc_expr *expr, tree desc, int dim,
bool assumed_size)
tmp = gfc_rank_cst[dim];
lbound = gfc_conv_descriptor_lbound_get (desc, tmp);
ubound = gfc_conv_descriptor_ubound_get (desc, tmp);
- stride = gfc_conv_descriptor_stride_get (desc, tmp);
+ sm = gfc_conv_descriptor_sm_get (desc, tmp);
cond1 = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
ubound, lbound);
cond3 = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
- stride, gfc_index_zero_node);
+ sm, gfc_index_zero_node);
cond3 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
logical_type_node, cond3, cond1);
cond4 = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
- stride, gfc_index_zero_node);
+ sm, gfc_index_zero_node);
if (assumed_size)
cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
tmp, build_int_cst (gfc_array_index_type,
@@ -3680,7 +3697,7 @@ gfc_set_descriptor_for_assign_realloc (stmtblock_t
*block, gfc_loopinfo *loop,
to the corresponding element of LBOUND(expr)."
Reuse size1 to keep a dimension-by-dimension track of the
stride of the new array. */
- tree size1 = gfc_index_one_node;
+ tree size1 = elemsize2;
tree offset = gfc_index_zero_node;
for (int n = 0; n < expr2->rank; n++)
@@ -3705,15 +3722,9 @@ gfc_set_descriptor_for_assign_realloc (stmtblock_t
*block, gfc_loopinfo *loop,
lbound = lbd;
}
- gfc_conv_descriptor_lbound_set (block, desc,
- gfc_rank_cst[n],
- lbound);
- gfc_conv_descriptor_ubound_set (block, desc,
- gfc_rank_cst[n],
- ubound);
- gfc_conv_descriptor_stride_set (block, desc,
- gfc_rank_cst[n],
- size1);
+ gfc_conv_descriptor_lbound_set (block, desc, gfc_rank_cst[n], lbound);
+ gfc_conv_descriptor_ubound_set (block, desc, gfc_rank_cst[n], ubound);
+ gfc_conv_descriptor_sm_set (block, desc, gfc_rank_cst[n], size1);
lbound = gfc_conv_descriptor_lbound_get (desc,
gfc_rank_cst[n]);
tree tmp2 = fold_build2_loc (input_location, MULT_EXPR,
@@ -3811,7 +3822,9 @@ gfc_set_pdt_array_descriptor (stmtblock_t *block, tree
desc,
fields can then be filled from the values so obtained. */
gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)));
- tree size = gfc_index_one_node;
+ gfc_conv_descriptor_dtype_set (block, desc,
+ gfc_get_dtype (TREE_TYPE (desc)));
+ tree size = gfc_conv_descriptor_elem_len_get (desc);
tree offset = gfc_index_zero_node;
for (int i = 0; i < as->rank; i++)
{
@@ -3830,17 +3843,11 @@ gfc_set_pdt_array_descriptor (stmtblock_t *block, tree
desc,
gfc_conv_expr_type (&tse, e, gfc_array_index_type);
gfc_free_expr (e);
tree upper = tse.expr;
- gfc_conv_descriptor_ubound_set (block, desc,
- gfc_rank_cst[i],
- upper);
- gfc_conv_descriptor_stride_set (block, desc,
- gfc_rank_cst[i],
- size);
+ gfc_conv_descriptor_ubound_set (block, desc, gfc_rank_cst[i], upper);
+ gfc_conv_descriptor_sm_set (block, desc, gfc_rank_cst[i], size);
size = gfc_evaluate_now (size, block);
- offset = fold_build2_loc (input_location,
- MINUS_EXPR,
- gfc_array_index_type,
- offset, size);
+ offset = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, offset, size);
offset = gfc_evaluate_now (offset, block);
tree tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
@@ -3852,8 +3859,6 @@ gfc_set_pdt_array_descriptor (stmtblock_t *block, tree
desc,
gfc_array_index_type, size, tmp);
}
gfc_conv_descriptor_offset_set (block, desc, offset);
- gfc_conv_descriptor_dtype_set (block, desc,
- gfc_get_dtype (TREE_TYPE (desc)));
return size;
}
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 78e5907fe44e..e49d447bb85e 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -4798,7 +4798,7 @@ gfc_set_interface_mapping_bounds (stmtblock_t * block,
tree type, tree desc)
for (n = 0; n < GFC_TYPE_ARRAY_RANK (type); n++)
{
dim = gfc_rank_cst[n];
- GFC_TYPE_ARRAY_STRIDE (type, n) = gfc_conv_array_stride (desc, n);
+ GFC_TYPE_ARRAY_SM (type, n) = gfc_conv_array_sm (desc, n);
if (GFC_TYPE_ARRAY_LBOUND (type, n) == NULL_TREE)
{
GFC_TYPE_ARRAY_LBOUND (type, n)
@@ -4820,7 +4820,7 @@ gfc_set_interface_mapping_bounds (stmtblock_t * block,
tree type, tree desc)
}
tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
GFC_TYPE_ARRAY_LBOUND (type, n),
- GFC_TYPE_ARRAY_STRIDE (type, n));
+ GFC_TYPE_ARRAY_SM (type, n));
offset = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, offset, tmp);
}
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index f226f1b5f038..7e0089161777 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -2309,7 +2309,7 @@ gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg)
{
gfc_ss *ss;
gfc_se argse;
- tree desc, tmp, stride, extent, cond;
+ tree desc, tmp, extent, cond;
int i;
tree fncall0;
gfc_array_spec *as;
@@ -2347,19 +2347,19 @@ gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg)
gfc_add_block_to_block (&se->post, &argse.post);
desc = gfc_evaluate_now (argse.expr, &se->pre);
- stride = gfc_conv_descriptor_stride_get (desc, gfc_rank_cst[0]);
+ tree sm = gfc_conv_descriptor_sm_get (desc, gfc_rank_cst[0]);
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
- stride, build_int_cst (TREE_TYPE (stride), 1));
+ sm, gfc_conv_descriptor_span_get (desc));
for (i = 0; i < arg->rank - 1; i++)
{
extent = gfc_conv_descriptor_extent_get (desc, gfc_rank_cst[i]);
- tmp = gfc_conv_descriptor_stride_get (desc, gfc_rank_cst[i]);
+ tmp = gfc_conv_descriptor_sm_get (desc, gfc_rank_cst[i]);
tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp),
tmp, extent);
- stride = gfc_conv_descriptor_stride_get (desc, gfc_rank_cst[i+1]);
+ sm = gfc_conv_descriptor_sm_get (desc, gfc_rank_cst[i+1]);
tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
- stride, tmp);
+ sm, tmp);
cond = fold_build2_loc (input_location, TRUTH_AND_EXPR,
boolean_type_node, cond, tmp);
}
@@ -2738,34 +2738,6 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
}
-static void
-conv_intrinsic_stride (gfc_se * se, gfc_expr * expr)
-{
- gfc_actual_arglist *array_arg;
- gfc_actual_arglist *dim_arg;
- gfc_se argse;
- tree desc, tmp;
-
- array_arg = expr->value.function.actual;
- dim_arg = array_arg->next;
-
- gcc_assert (array_arg->expr->expr_type == EXPR_VARIABLE);
-
- gfc_init_se (&argse, NULL);
- gfc_conv_expr_descriptor (&argse, array_arg->expr);
- gfc_add_block_to_block (&se->pre, &argse.pre);
- gfc_add_block_to_block (&se->post, &argse.post);
- desc = argse.expr;
-
- gcc_assert (dim_arg->expr);
- gfc_init_se (&argse, NULL);
- gfc_conv_expr_type (&argse, dim_arg->expr, gfc_array_index_type);
- gfc_add_block_to_block (&se->pre, &argse.pre);
- tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- argse.expr, gfc_index_one_node);
- se->expr = gfc_conv_descriptor_stride_get (desc, tmp);
-}
-
static void
gfc_conv_intrinsic_abs (gfc_se * se, gfc_expr * expr)
{
@@ -9031,7 +9003,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
}
else
tmp = gfc_rank_cst[arg1->expr->rank - 1];
- tmp = gfc_conv_descriptor_stride_get (arg1se.expr, tmp);
+ tmp = gfc_conv_descriptor_sm_get (arg1se.expr, tmp);
if (arg2->expr->rank != 0)
nonzero_arraylen = fold_build2_loc (input_location, NE_EXPR,
logical_type_node, tmp,
@@ -11294,10 +11266,6 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr *
expr)
gfc_conv_intrinsic_spacing (se, expr);
break;
- case GFC_ISYM_STRIDE:
- conv_intrinsic_stride (se, expr);
- break;
-
case GFC_ISYM_SUM:
gfc_conv_intrinsic_arith (se, expr, PLUS_EXPR, false);
break;
diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc
index 4ca0ed7f91b9..99df15dcd86b 100644
--- a/gcc/fortran/trans-io.cc
+++ b/gcc/fortran/trans-io.cc
@@ -751,7 +751,7 @@ gfc_convert_array_to_string (gfc_se * se, gfc_expr * e)
if (e->rank == 0)
{
- tree type, array, tmp;
+ tree type, array;
gfc_symbol *sym;
int rank;
@@ -765,40 +765,37 @@ gfc_convert_array_to_string (gfc_se * se, gfc_expr * e)
array = sym->backend_decl;
type = TREE_TYPE (array);
- tree elts_count;
+ tree elts_count = NULL_TREE;
+ tree full_size = NULL_TREE;
if (GFC_ARRAY_TYPE_P (type))
elts_count = GFC_TYPE_ARRAY_SIZE (type);
else
{
gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
- tree stride = gfc_conv_array_stride (array, rank);
- tmp = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- gfc_conv_array_ubound (array, rank),
- gfc_conv_array_lbound (array, rank));
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type, tmp,
- gfc_index_one_node);
- elts_count = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, tmp, stride);
+ tree sm = gfc_conv_array_sm (array, rank);
+ tree tmp = gfc_conv_array_extent (array, rank);
+ full_size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, tmp, sm);
}
- gcc_assert (elts_count);
+ gcc_assert (elts_count || full_size);
tree elt_size = TYPE_SIZE_UNIT (gfc_get_element_type (type));
elt_size = fold_convert (gfc_array_index_type, elt_size);
- tree size;
+ if (full_size == NULL_TREE)
+ full_size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, elts_count,
+ elt_size);
+
+ tree offset;
if (TREE_CODE (se->expr) == ARRAY_REF)
{
tree index = TREE_OPERAND (se->expr, 1);
index = fold_convert (gfc_array_index_type, index);
- elts_count = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- elts_count, index);
-
- size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, elts_count, elt_size);
+ offset = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, index,
+ elt_size);
}
else
{
@@ -806,15 +803,13 @@ gfc_convert_array_to_string (gfc_se * se, gfc_expr * e)
tree ptr = TREE_OPERAND (se->expr, 0);
gcc_assert (TREE_CODE (ptr) == POINTER_PLUS_EXPR);
- tree offset = fold_convert_loc (input_location, gfc_array_index_type,
- TREE_OPERAND (ptr, 1));
-
- size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, elts_count, elt_size);
- size = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type, size, offset);
+ offset = fold_convert_loc (input_location, gfc_array_index_type,
+ TREE_OPERAND (ptr, 1));
}
- gcc_assert (size);
+
+ gcc_assert (offset);
+ tree size = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, full_size, offset);
se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
se->string_length = fold_convert (gfc_charlen_type_node, size);
@@ -1823,7 +1818,7 @@ transfer_namelist_element (stmtblock_t * block, const
char * var_name,
iocall[IOCALL_SET_NML_VAL_DIM], 5,
dt_parm_addr,
build_int_cst (gfc_int4_type_node, n_dim),
- gfc_conv_array_stride (decl, n_dim),
+ gfc_conv_array_sm (decl, n_dim),
gfc_conv_array_lbound (decl, n_dim),
gfc_conv_array_ubound (decl, n_dim));
gfc_add_expr_to_block (block, tmp);
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 4ac7ea0893c1..e6afb84c031d 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -1869,7 +1869,7 @@ gfc_omp_firstprivatize_type_sizes (struct
gimplify_omp_ctx *ctx, tree type)
{
omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_LBOUND (type, r));
omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_UBOUND (type, r));
- omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_STRIDE (type, r));
+ omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_SM (type, r));
}
omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_SIZE (type));
omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_OFFSET (type));
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index f3527694e800..72b7d715fe1b 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -1488,7 +1488,7 @@ gfc_get_element_type (tree type)
struct descriptor_dimension
{
- index stride;
+ index sm;
index lbound;
index ubound;
}
@@ -1661,9 +1661,9 @@ gfc_get_desc_dim_type (void)
TYPE_NAME (type) = get_identifier ("descriptor_dimension");
TYPE_PACKED (type) = 1;
- /* Consists of the stride, lbound and ubound members. */
+ /* Consists of the sm, lbound and ubound members. */
decl = gfc_add_field_to_struct_1 (type,
- get_identifier ("stride"),
+ get_identifier ("sm"),
gfc_array_index_type, &chain);
suppress_warning (decl);
@@ -1855,11 +1855,15 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec *
as, gfc_packed packed,
int known_offset;
mpz_t offset;
mpz_t stride;
+ mpz_t sm;
mpz_t delta;
gfc_expr *expr;
mpz_init_set_ui (offset, 0);
mpz_init_set_ui (stride, 1);
+ wide_int elem_len = wi::to_wide (TYPE_SIZE_UNIT (etype));
+ gcc_assert (wi::fits_shwi_p (elem_len));
+ mpz_init_set_ui (sm, elem_len.to_shwi ());
mpz_init (delta);
/* We don't use build_array_type because this does not include
@@ -1877,12 +1881,12 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec *
as, gfc_packed packed,
known_offset = 1;
for (n = 0; n < as->rank; n++)
{
- /* Fill in the stride and bound components of the type. */
+ /* Fill in the sm and bound components of the type. */
if (known_stride)
- tmp = gfc_conv_mpz_to_tree (stride, gfc_index_integer_kind);
+ tmp = gfc_conv_mpz_to_tree (sm, gfc_index_integer_kind);
else
tmp = NULL_TREE;
- GFC_TYPE_ARRAY_STRIDE (type, n) = tmp;
+ GFC_TYPE_ARRAY_SM (type, n) = tmp;
expr = as->lower[n];
if (expr && expr->expr_type == EXPR_CONSTANT)
@@ -1900,7 +1904,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec *
as, gfc_packed packed,
if (known_stride)
{
/* Calculate the offset. */
- mpz_mul (delta, stride, as->lower[n]->value.integer);
+ mpz_mul (delta, sm, as->lower[n]->value.integer);
mpz_sub (offset, offset, delta);
}
else
@@ -1926,6 +1930,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec *
as, gfc_packed packed,
as->lower[n]->value.integer);
mpz_add_ui (delta, delta, 1);
mpz_mul (stride, stride, delta);
+ mpz_mul (sm, sm, delta);
}
/* Only the first stride is known for partial packed arrays. */
@@ -1968,6 +1973,9 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec *
as, gfc_packed packed,
else
GFC_TYPE_ARRAY_SIZE (type) = NULL_TREE;
+ if (packed != PACKED_NO)
+ GFC_TYPE_ARRAY_ELEM_LEN (type) = TYPE_SIZE_UNIT (etype);
+
GFC_TYPE_ARRAY_RANK (type) = as->rank;
GFC_TYPE_ARRAY_CORANK (type) = as->corank;
GFC_TYPE_ARRAY_DTYPE (type) = NULL_TREE;
@@ -2047,6 +2055,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec *
as, gfc_packed packed,
array_type_done:
mpz_clear (offset);
mpz_clear (stride);
+ mpz_clear (sm);
mpz_clear (delta);
return type;
@@ -2202,14 +2211,21 @@ gfc_get_array_type_bounds (tree etype, int dimen, int
codimen, tree * lbound,
GFC_TYPE_ARRAY_AKIND (fat_type) = akind;
/* Build an array descriptor record type. */
+ tree sm;
if (packed != 0)
- stride = gfc_index_one_node;
+ {
+ stride = gfc_index_one_node;
+ sm = TYPE_SIZE_UNIT (etype);
+ }
else
- stride = NULL_TREE;
+ {
+ stride = NULL_TREE;
+ sm = NULL_TREE;
+ }
for (n = 0; n < dimen + codimen; n++)
{
if (n < dimen)
- GFC_TYPE_ARRAY_STRIDE (fat_type, n) = stride;
+ GFC_TYPE_ARRAY_SM (fat_type, n) = sm;
if (lbound)
lower = lbound[n];
@@ -2241,18 +2257,19 @@ gfc_get_array_type_bounds (tree etype, int dimen, int
codimen, tree * lbound,
if (upper != NULL_TREE && lower != NULL_TREE && stride != NULL_TREE)
{
- tmp = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type, upper, lower);
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type, tmp,
- gfc_index_one_node);
+ tmp = gfc_conv_array_extent_dim (lower, upper, nullptr);
stride = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type, tmp, stride);
+ sm = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, tmp, sm);
/* Check the folding worked. */
gcc_assert (INTEGER_CST_P (stride));
}
else
- stride = NULL_TREE;
+ {
+ stride = NULL_TREE;
+ sm = NULL_TREE;
+ }
}
GFC_TYPE_ARRAY_SIZE (fat_type) = stride;
@@ -3829,8 +3846,8 @@ gfc_get_array_descr_info (const_tree type, struct
array_descr_info *info)
int rank, dim;
bool indirect = false;
tree etype, ptype, t, base_decl;
- tree data_off, span_off, dim_off, dtype_off, dim_size, elem_size;
- tree lower_suboff, upper_suboff, stride_suboff;
+ tree data_off, span_off, dim_off, dtype_off, dim_size;
+ tree lower_suboff, upper_suboff, sm_suboff;
tree dtype, field, rank_off;
if (! GFC_DESCRIPTOR_TYPE_P (type))
@@ -3885,12 +3902,9 @@ gfc_get_array_descr_info (const_tree type, struct
array_descr_info *info)
base_decl = build1 (INDIRECT_REF, ptype, base_decl);
gfc_get_descriptor_offsets_for_info (type, &data_off, &dtype_off, &span_off,
- &dim_off, &dim_size, &stride_suboff,
+ &dim_off, &dim_size, &sm_suboff,
&lower_suboff, &upper_suboff);
- t = fold_build_pointer_plus (base_decl, span_off);
- elem_size = build1 (INDIRECT_REF, gfc_array_index_type, t);
-
t = base_decl;
if (!integer_zerop (data_off))
t = fold_build_pointer_plus (t, data_off);
@@ -3960,9 +3974,8 @@ gfc_get_array_descr_info (const_tree type, struct
array_descr_info *info)
}
t = fold_build_pointer_plus (base_decl,
size_binop (PLUS_EXPR,
- dim_off, stride_suboff));
+ dim_off, sm_suboff));
t = build1 (INDIRECT_REF, gfc_array_index_type, t);
- t = build2 (MULT_EXPR, gfc_array_index_type, t, elem_size);
info->dimen[dim].stride = t;
if (dim + 1 < rank)
dim_off = size_binop (PLUS_EXPR, dim_off, dim_size);
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 83b9b9b905fd..3e985bdb9127 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -196,20 +196,33 @@ typedef struct gfc_array_info
tree descriptor;
/* holds the pointer to the data array. */
tree data;
+ /* Original data pointer without additional offset. */
+ tree saved_data;
/* To move some of the array index calculation out of the innermost loop. */
tree offset;
+ /* Original offset. */
tree saved_offset;
- tree stride0;
/* Holds the SS for a subscript. Indexed by actual dimension. */
struct gfc_ss *subscript[GFC_MAX_DIMENSIONS];
- /* stride and delta are used to access this inside a scalarization loop.
+ /* stride, spacing and delta are used to access this inside a scalarization
loop.
start is used in the calculation of these. Indexed by scalarizer
dimension. */
tree start[GFC_MAX_DIMENSIONS];
tree end[GFC_MAX_DIMENSIONS];
+ /* The spacing of indexes, that may be specified by the strides of array
+ references. */
tree stride[GFC_MAX_DIMENSIONS];
+ /* The spacing in memory of elements of consecutive indexes, for each
+ dimension. This is the intrinsic spacing of the array given by its stride
+ multiplier (sm). In units whose size is given by the element type if
+ array_access is true, otherwise in bytes. */
+ tree spacing[GFC_MAX_DIMENSIONS];
tree delta[GFC_MAX_DIMENSIONS];
+
+ /* False: access with pointer arithmetics.
+ True: access with array reference. */
+ bool array_access;
}
gfc_array_info;
@@ -1025,7 +1038,8 @@ struct GTY(()) lang_type {
enum gfc_array_kind akind;
tree lbound[GFC_MAX_DIMENSIONS];
tree ubound[GFC_MAX_DIMENSIONS];
- tree stride[GFC_MAX_DIMENSIONS];
+ tree sm[GFC_MAX_DIMENSIONS];
+ tree elem_len;
tree size;
tree offset;
tree dtype;
@@ -1097,8 +1111,20 @@ struct GTY(()) lang_decl {
(TYPE_LANG_SPECIFIC(node)->lbound[dim])
#define GFC_TYPE_ARRAY_UBOUND(node, dim) \
(TYPE_LANG_SPECIFIC(node)->ubound[dim])
+#define GFC_TYPE_ARRAY_SM(node, dim) \
+ (TYPE_LANG_SPECIFIC(node)->sm[dim])
+#define GFC_TYPE_ARRAY_EXTENT(node, dim) \
+ (fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, \
+ fold_build2_loc (input_location, MINUS_EXPR, \
+ gfc_array_index_type, \
+ GFC_TYPE_ARRAY_UBOUND((node), (dim)), \
+ GFC_TYPE_ARRAY_LBOUND((node), (dim))), \
+ gfc_index_one_node))
#define GFC_TYPE_ARRAY_STRIDE(node, dim) \
- (TYPE_LANG_SPECIFIC(node)->stride[dim])
+ (fold_build2_loc (input_location, EXACT_DIV_EXPR, gfc_array_index_type, \
+ GFC_TYPE_ARRAY_SM((node), (dim)), \
+ GFC_TYPE_ARRAY_ELEM_LEN((node))))
+#define GFC_TYPE_ARRAY_ELEM_LEN(node) (TYPE_LANG_SPECIFIC(node)->elem_len)
#define GFC_TYPE_ARRAY_RANK(node) (TYPE_LANG_SPECIFIC(node)->rank)
#define GFC_TYPE_ARRAY_CORANK(node) (TYPE_LANG_SPECIFIC(node)->corank)
#define GFC_TYPE_ARRAY_CAF_TOKEN(node) (TYPE_LANG_SPECIFIC(node)->caf_token)
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 3fc53938b4a2..4b9a3c820dcd 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -4929,7 +4929,7 @@ export_proto(st_set_nml_var_dim);
void
st_set_nml_var_dim (st_parameter_dt *dtp, GFC_INTEGER_4 n_dim,
- index_type stride, index_type lbound,
+ index_type sm, index_type lbound,
index_type ubound)
{
namelist_info *nml;
@@ -4939,7 +4939,7 @@ st_set_nml_var_dim (st_parameter_dt *dtp, GFC_INTEGER_4
n_dim,
for (nml = dtp->u.p.ionml; nml->next; nml = nml->next);
- GFC_DIMENSION_SET(nml->dim[n],lbound,ubound,stride);
+ GFC_DIMENSION_SET(nml->dim[n],lbound,ubound,sm);
}
