[gcc(refs/users/mikael/heads/refactor_descriptor_v05)] Sauvegarde modifs.
Mikael Morin
mikael@gcc.gnu.org
Fri Jun 13 14:54:00 GMT 2025
https://gcc.gnu.org/g:7bced841f0e8bd8e323fb27fc8add05f2c970914
commit 7bced841f0e8bd8e323fb27fc8add05f2c970914
Author: Mikael Morin <mikael@gcc.gnu.org>
Date: Wed Apr 2 16:28:11 2025 +0200
Sauvegarde modifs.
Sauvegarde spacing compilation OK
Correction régressions, y compris aliasing_dummy_1.f90
Correction actual_array_constructor_1.f90
Correction ICE aliasing_dummy_4.f90
Correction régression y compris PR100094
Sauvegarde correction régressions.
Sauvegarde.
Diff:
---
gcc/fortran/class.cc | 244 ++--------
gcc/fortran/intrinsic.cc | 8 -
gcc/fortran/trans-array.cc | 759 ++++++++++++++++---------------
gcc/fortran/trans-array.h | 4 +-
gcc/fortran/trans-decl.cc | 10 +-
gcc/fortran/trans-descriptor.cc | 402 +++++++++-------
gcc/fortran/trans-descriptor.h | 5 +-
gcc/fortran/trans-expr.cc | 64 +--
gcc/fortran/trans-intrinsic.cc | 67 +--
gcc/fortran/trans-io.cc | 60 +--
gcc/fortran/trans-openmp.cc | 58 ++-
gcc/fortran/trans-stmt.cc | 36 +-
gcc/fortran/trans-types.cc | 131 ++++--
gcc/fortran/trans.cc | 111 +----
gcc/fortran/trans.h | 41 +-
libgfortran/caf/single.c | 6 +-
libgfortran/intrinsics/associated.c | 2 +-
libgfortran/intrinsics/cshift0.c | 20 +-
libgfortran/intrinsics/eoshift0.c | 32 +-
libgfortran/intrinsics/eoshift2.c | 11 +-
libgfortran/intrinsics/move_alloc.c | 3 +-
libgfortran/intrinsics/pack_generic.c | 2 +
libgfortran/intrinsics/reshape_generic.c | 6 +-
libgfortran/intrinsics/spread_generic.c | 23 +-
libgfortran/intrinsics/unpack_generic.c | 19 +-
libgfortran/io/transfer.c | 4 +-
libgfortran/libgfortran.h | 25 +-
libgfortran/m4/reshape.m4 | 6 +-
28 files changed, 1035 insertions(+), 1124 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 9e07627503de..c39cb85784a6 100644
--- a/gcc/fortran/intrinsic.cc
+++ b/gcc/fortran/intrinsic.cc
@@ -3179,14 +3179,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 42681986d3e0..8a7d39ae4e9f 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], spacing[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,10 @@ 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 = fold_build2_loc (input_location, EXACT_DIV_EXPR, gfc_array_index_type,
+ elemsize, build_int_cst (gfc_array_index_type,
+ TYPE_ALIGN_UNIT (eltype)));
/*
Fill in the bounds and stride. This is a packed array, so:
@@ -1188,7 +1195,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;
+ spacing[n] = size;
tree extent = to[n];
if (!shift_bounds && !integer_zerop (from[n]))
@@ -1240,9 +1247,10 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
nelem, initial, dynamic,
dealloc);
- gfc_set_temporary_descriptor (pre, desc, class_expr, elemsize, data_ptr,
- from, to, stride, total_dim, !bounds_known,
- rank_changer, shift_bounds);
+ gfc_set_temporary_descriptor (pre, desc, class_expr, elemsize,
+ GFC_TYPE_ARRAY_ALIGN (TREE_TYPE (desc)),
+ data_ptr, from, to, spacing, total_dim,
+ !bounds_known, rank_changer, shift_bounds);
while (ss->parent)
ss = ss->parent;
@@ -1388,7 +1396,7 @@ gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
/* Store the value. */
tmp = build_fold_indirect_ref_loc (input_location,
gfc_conv_descriptor_data_get (desc));
- tmp = gfc_build_array_ref (tmp, offset, NULL);
+ tmp = gfc_build_array_ref (tmp, offset, true);
if (expr->expr_type == EXPR_FUNCTION && expr->ts.type == BT_DERIVED
&& expr->ts.u.derived->attr.alloc_comp)
@@ -1719,7 +1727,7 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock,
tmp = gfc_conv_descriptor_data_get (desc);
tmp = build_fold_indirect_ref_loc (input_location,
tmp);
- tmp = gfc_build_array_ref (tmp, *poffset, NULL);
+ tmp = gfc_build_array_ref (tmp, *poffset, true);
tmp = gfc_build_addr_expr (NULL_TREE, tmp);
init = gfc_build_addr_expr (NULL_TREE, init);
@@ -2175,6 +2183,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 +2229,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 +2831,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_spacing_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 +2956,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 +2977,20 @@ 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;
tmp = gfc_conv_array_offset (se.expr);
if (!ss->is_alloc_lhs)
@@ -2960,6 +3001,11 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base)
so that the variable is still accessible after the loops
are translated. */
info->saved_offset = info->offset;
+
+ tmp = gfc_conv_array_align (se.expr);
+ if (!ss->is_alloc_lhs)
+ tmp = gfc_evaluate_now (tmp, block);
+ info->align = tmp;
}
}
@@ -3034,10 +3080,24 @@ gfc_conv_array_offset (tree descriptor)
}
+/* Return an expression for the base alignment of an array. */
+
+tree
+gfc_conv_array_align (tree descriptor)
+{
+ tree type = TREE_TYPE (descriptor);
+ tree tmp = GFC_TYPE_ARRAY_ALIGN (type);
+ if (tmp != NULL_TREE)
+ return tmp;
+
+ return gfc_conv_descriptor_align_get (descriptor);
+}
+
+
/* Get an expression for the array stride. */
tree
-gfc_conv_array_stride (tree descriptor, int dim)
+gfc_conv_array_spacing (tree descriptor, int dim)
{
tree tmp;
tree type;
@@ -3045,16 +3105,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_SPACING (type, dim);
if (tmp != NULL_TREE)
return tmp;
- tmp = gfc_conv_descriptor_stride_get (descriptor, gfc_rank_cst[dim]);
+ tmp = gfc_conv_descriptor_spacing_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 +3133,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 +3157,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 +3369,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 +3486,123 @@ non_negative_strides_array_p (tree expr)
}
+static tree
+build_array_ref (tree desc, tree offset)
+{
+ tree tmp;
+
+ tmp = gfc_conv_array_data (desc);
+ tmp = build_fold_indirect_ref_loc (input_location, tmp);
+ tmp = gfc_build_array_ref (tmp, offset, non_negative_strides_array_p (desc),
+ gfc_index_one_node, gfc_conv_array_align (desc));
+ 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 descriptor;
+ 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);
+
+ /* 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]);
+
+ descriptor = info->subscript[dim]->info->data.array.descriptor;
+ index = fold_convert_loc (input_location, gfc_array_index_type, index);
+
+ /* Read the vector to get an index into info->descriptor. */
+ data = build_fold_indirect_ref_loc (input_location,
+ gfc_conv_array_data (descriptor));
+ index = gfc_build_array_ref (data, index,
+ gfc_conv_array_spacing (descriptor, 0),
+ gfc_conv_array_align (descriptor));
+ 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
@@ -3539,22 +3610,20 @@ 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 index;
tree base;
gfc_ss *ss;
- gfc_expr *expr;
int n;
ss = se->ss;
- expr = ss->info->expr;
info = &ss->info->data.array;
if (ar)
n = se->loop->order[0];
else
n = 0;
- index = conv_array_index_offset (se, ss, ss->dim[n], n, ar, info->stride0);
+ tree index = conv_array_index_offset (se, ss, ss->dim[n], n, ar,
+ info->spacing[ss->dim[n]]);
+
/* Add the offset for this dimension to the stored offset for all other
dimensions. */
if (info->offset && !integer_zerop (info->offset))
@@ -3567,29 +3636,11 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar,
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, decl,
- non_negative_stride);
+ se->expr = gfc_build_array_ref (base, index, non_negative_stride,
+ tmp_array ? NULL_TREE : gfc_index_one_node,
+ tmp_array ? NULL_TREE : info->align);
}
@@ -3621,43 +3672,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 +3685,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 +3740,18 @@ 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);
+ 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 +3818,11 @@ 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 spacing. */
+ tree tmp = gfc_conv_array_spacing (decl, n);
+
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);
@@ -3808,53 +3832,8 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr,
offset = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type, offset, cst_offset);
- /* A pointer array component can be detected from its field decl. Fix
- the descriptor, mark the resulting variable decl and pass it to
- build_array_ref. */
- decl = NULL_TREE;
- if (get_CFI_desc (sym, expr, &decl, ar))
- decl = build_fold_indirect_ref_loc (input_location, decl);
- if (!expr->ts.deferred && !sym->attr.codimension
- && is_pointer_array (se->expr))
- {
- if (TREE_CODE (se->expr) == COMPONENT_REF)
- decl = se->expr;
- else if (INDIRECT_REF_P (se->expr))
- decl = TREE_OPERAND (se->expr, 0);
- else
- decl = se->expr;
- }
- else if (expr->ts.deferred
- || (sym->ts.type == BT_CHARACTER
- && sym->attr.select_type_temporary))
- {
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se->expr)))
- {
- decl = se->expr;
- if (INDIRECT_REF_P (decl))
- decl = TREE_OPERAND (decl, 0);
- }
- else
- decl = sym->backend_decl;
- }
- else if (sym->ts.type == BT_CLASS)
- {
- if (UNLIMITED_POLY (sym))
- {
- gfc_expr *class_expr = gfc_find_and_cut_at_last_class_ref (expr);
- gfc_init_se (&tmpse, NULL);
- gfc_conv_expr (&tmpse, class_expr);
- if (!se->class_vptr)
- se->class_vptr = gfc_class_vptr_get (tmpse.expr);
- gfc_free_expr (class_expr);
- decl = tmpse.expr;
- }
- else
- decl = NULL_TREE;
- }
-
free (var_name);
- se->expr = build_array_ref (se->expr, offset, decl, se->class_vptr);
+ se->expr = build_array_ref (se->expr, offset);
}
@@ -3867,21 +3846,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 +3884,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 +3939,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 +3972,7 @@ 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;
}
}
@@ -4283,6 +4266,48 @@ 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;
+
+ value = gfc_conv_array_spacing (desc, dim);
+
+#if 0
+ if (GFC_ARRAY_TYPE_P (type)
+ && GFC_TYPE_ARRAY_SPACING (type, dim) != NULL_TREE)
+ value = GFC_TYPE_ARRAY_SPACING (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);
+ }
+#endif
+
+ 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 +4616,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 +4637,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);
@@ -6179,7 +6208,7 @@ gfc_trans_array_cobounds (tree type, stmtblock_t * pblock,
/* Generate code to evaluate non-constant array bounds. Sets *poffset and
- returns the size (in elements) of the array. */
+ returns the size (in align units) of the array. */
tree
gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree * poffset,
@@ -6187,7 +6216,6 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree * poffset,
{
gfc_array_spec *as;
tree size;
- tree stride;
tree offset;
tree ubound;
tree lbound;
@@ -6198,11 +6226,13 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree * poffset,
as = IS_CLASS_COARRAY_OR_ARRAY (sym) ? CLASS_DATA (sym)->as : sym->as;
- size = gfc_index_one_node;
+ tree eltype = gfc_get_element_type (type);
+ tree elem_len = fold_convert_loc (input_location, gfc_array_index_type,
+ TYPE_SIZE_UNIT (eltype));
+
+ size = fold_build2_loc (input_location, EXACT_DIV_EXPR, gfc_array_index_type,
+ elem_len, GFC_TYPE_ARRAY_ALIGN (type));
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);
for (dim = 0; dim < as->rank; dim++)
{
/* Evaluate non-constant array bound expressions.
@@ -6228,44 +6258,41 @@ 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,
offset, tmp);
/* The size of this dimension, and the stride of the next. */
+ tree spacing;
if (dim + 1 < as->rank)
- stride = GFC_TYPE_ARRAY_STRIDE (type, dim + 1);
+ spacing = GFC_TYPE_ARRAY_SPACING (type, dim + 1);
else
- stride = GFC_TYPE_ARRAY_SIZE (type);
+ spacing = GFC_TYPE_ARRAY_SIZE (type);
- if (ubound != NULL_TREE && !(stride && INTEGER_CST_P (stride)))
+ if (ubound != NULL_TREE && !(spacing && INTEGER_CST_P (spacing)))
{
- /* 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 spacing = size * (ubound + 1 - lbound). */
+ tmp = gfc_conv_array_extent_dim (lbound, ubound, nullptr);
tmp = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type, size, tmp);
- if (stride)
- gfc_add_modify (pblock, stride, tmp);
+ if (spacing)
+ gfc_add_modify (pblock, spacing, tmp);
else
- stride = gfc_evaluate_now (tmp, pblock);
+ spacing = 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);
+ spacing, 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);
+ spacing, gfc_index_zero_node);
+ gfc_add_modify (pblock, spacing, tmp);
}
- size = stride;
+ size = spacing;
}
gfc_trans_array_cobounds (type, pblock, sym);
@@ -6362,15 +6389,13 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym,
}
if (sym->attr.omp_allocate)
{
- /* The size is the number of elements in the array, so multiply by the
- size of an element to get the total size. */
- tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
- size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- size, fold_convert (gfc_array_index_type, tmp));
size = gfc_evaluate_now (size, &init);
tree omp_alloc = lookup_attribute ("omp allocate",
DECL_ATTRIBUTES (decl));
+ size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, size,
+ GFC_TYPE_ARRAY_ALIGN (type));
TREE_CHAIN (TREE_CHAIN (TREE_VALUE (omp_alloc)))
= build_tree_list (size, NULL_TREE);
space = NULL_TREE;
@@ -6385,12 +6410,9 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym,
}
else
{
- /* The size is the number of elements in the array, so multiply by the
- size of an element to get the total size. */
- tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
- size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- size, fold_convert (gfc_array_index_type, tmp));
-
+ size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, size,
+ GFC_TYPE_ARRAY_ALIGN (type));
/* Allocate memory to hold the data. */
tmp = gfc_call_malloc (&init, TREE_TYPE (decl), size);
gfc_add_modify (&init, decl, tmp);
@@ -6526,7 +6548,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
tree dextent;
tree dumdesc;
tree tmp;
- tree stride, stride2;
+ tree stride2, spacing = NULL_TREE;
tree stmt_packed;
tree stmt_unpacked;
tree partial;
@@ -6587,9 +6609,11 @@ 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_spacing_get (dumdesc, gfc_rank_cst[0]);
+ tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ tmp, gfc_conv_descriptor_align_get (dumdesc));
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 +6624,30 @@ 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);
+ spacing = GFC_TYPE_ARRAY_SPACING (type, 0);
+ if (!INTEGER_CST_P (spacing))
+ {
+ tmp = gfc_conv_descriptor_spacing_get (dumdesc, gfc_rank_cst[0]);
+ tmp = gfc_evaluate_now (tmp, &init);
+ gfc_add_modify (&init, spacing, tmp);
+ }
/* Allow the user to disable array repacking. */
stmt_unpacked = NULL_TREE;
}
else
{
- gcc_assert (integer_onep (GFC_TYPE_ARRAY_STRIDE (type, 0)));
/* 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;
+ spacing = gfc_conv_descriptor_span_get (dumdesc);
+ spacing = fold_convert_loc (input_location, gfc_array_index_type,
+ spacing);
+ spacing = fold_build2_loc (input_location, EXACT_DIV_EXPR,
+ gfc_array_index_type, spacing,
+ GFC_TYPE_ARRAY_ALIGN (type));
if (warn_array_temporaries)
{
@@ -6652,6 +6678,10 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
offset = gfc_index_zero_node;
size = gfc_index_one_node;
+ tree spacing_units = gfc_conv_descriptor_span_get (dumdesc);
+ spacing_units = fold_build2_loc (input_location, EXACT_DIV_EXPR,
+ gfc_array_index_type, spacing_units,
+ GFC_TYPE_ARRAY_ALIGN (TREE_TYPE (tmpdesc)));
/* Evaluate the bounds of the array. */
for (n = 0; n < as->rank; n++)
@@ -6672,6 +6702,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 +6726,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 +6751,59 @@ 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 * spacing. */
tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- lbound, stride);
+ lbound, spacing);
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 spacing of the next. */
if (n + 1 < as->rank)
{
- stride = GFC_TYPE_ARRAY_STRIDE (type, n + 1);
+ spacing = GFC_TYPE_ARRAY_SPACING (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_spacing_get (dumdesc, gfc_rank_cst[n+1]);
- /* Figure out the stride if not a known constant. */
- if (!INTEGER_CST_P (stride))
+ /* Figure out the spacing if not a known constant. */
+ if (!INTEGER_CST_P (spacing))
{
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 spacing = size * (ubound + 1 - lbound). */
size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size, tmp);
- stmt_packed = size;
+ gfc_array_index_type, size, extent);
+ spacing_units = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type,
+ spacing_units, extent);
+
+ stmt_packed = spacing_units;
}
- /* Assign the stride. */
+ /* Assign the spacing. */
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);
+ gfc_add_modify (&init, spacing, tmp);
}
}
else
{
- stride = GFC_TYPE_ARRAY_SIZE (type);
+ spacing = GFC_TYPE_ARRAY_SIZE (type);
- if (stride && !INTEGER_CST_P (stride))
+ if (spacing && !INTEGER_CST_P (spacing))
{
/* 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);
+ size, extent);
+ gfc_add_modify (&init, spacing, tmp);
}
}
}
@@ -6886,7 +6906,7 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset,
return;
}
- tmp = build_array_ref (desc, offset, NULL, NULL);
+ tmp = build_array_ref (desc, offset);
/* Offset the data pointer for pointer assignments from arrays with
subreferences; e.g. my_integer => my_type(:)%integer_component. */
@@ -6919,7 +6939,7 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset,
gfc_init_se (&start, NULL);
gfc_conv_expr_type (&start, ref->u.ss.start, gfc_charlen_type_node);
gfc_add_block_to_block (block, &start.pre);
- tmp = gfc_build_array_ref (tmp, start.expr, NULL);
+ tmp = gfc_build_array_ref (tmp, start.expr, true);
break;
case REF_ARRAY:
@@ -6964,7 +6984,7 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset,
}
/* Apply the index to obtain the array element. */
- tmp = gfc_build_array_ref (tmp, index, NULL);
+ tmp = gfc_build_array_ref (tmp, index, true);
break;
case REF_INQUIRY:
@@ -8443,15 +8463,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);
}
@@ -8829,13 +8860,13 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
/* Build the body of the loop. */
gfc_init_block (&loopbody);
- vref = gfc_build_array_ref (var, index, NULL);
+ vref = gfc_build_array_ref (var, index, true);
if (purpose == COPY_ALLOC_COMP || purpose == COPY_ONLY_ALLOC_COMP)
{
tmp = build_fold_indirect_ref_loc (input_location,
gfc_conv_array_data (dest));
- dref = gfc_build_array_ref (tmp, index, NULL);
+ dref = gfc_build_array_ref (tmp, index, true);
tmp = structure_alloc_comps (der_type, vref, dref, rank,
COPY_ALLOC_COMP, caf_mode, args,
no_finalization);
@@ -10187,8 +10218,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_spacing_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..d52c1a859459 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -160,10 +160,12 @@ void gfc_conv_array_parameter (gfc_se *, gfc_expr *, bool, const gfc_symbol *,
/* These work with both descriptors and descriptorless arrays. */
tree gfc_conv_array_data (tree);
tree gfc_conv_array_offset (tree);
+tree gfc_conv_array_align (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_spacing (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 f2bc7edf8e50..1908ec659e24 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_SPACING (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_SPACING (type, dim) = create_index_var ("spacing", nest);
+ suppress_warning (GFC_TYPE_ARRAY_SPACING (type, dim));
}
}
for (dim = GFC_TYPE_ARRAY_RANK (type);
@@ -7592,7 +7592,9 @@ done:
tmp = gfc_conv_descriptor_extent_get (gfc_desc, idx);
gfc_add_modify (&loop_body, gfc_get_cfi_dim_extent (cfi, idx), tmp);
/* d->dim[n].sm = gfc->dim[i].stride * gfc->span); */
- tmp = gfc_conv_descriptor_sm_get (gfc_desc, idx);
+ tmp = gfc_conv_descriptor_spacing_get (gfc_desc, idx);
+ tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ tmp, gfc_conv_descriptor_align_get (gfc_desc));
gfc_add_modify (&loop_body, gfc_get_cfi_dim_sm (cfi, idx), tmp);
/* Generate loop. */
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 7e709609435c..b1516e640625 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -106,7 +106,7 @@ static tree
gfc_get_cfi_dim_item (tree desc, tree idx, unsigned field_idx)
{
tree tmp = gfc_get_cfi_descriptor_field (desc, CFI_FIELD_DIM);
- tmp = gfc_build_array_ref (tmp, idx, NULL_TREE, true);
+ tmp = gfc_build_array_ref (tmp, idx, true);
tree field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)), field_idx);
gcc_assert (field != NULL_TREE);
return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
@@ -165,10 +165,11 @@ gfc_get_cfi_dim_sm (tree desc, tree idx)
#define OFFSET_FIELD 1
#define DTYPE_FIELD 2
#define SPAN_FIELD 3
-#define DIMENSION_FIELD 4
-#define CAF_TOKEN_FIELD 5
+#define ALIGN_FIELD 4
+#define DIMENSION_FIELD 5
+#define CAF_TOKEN_FIELD 6
-#define STRIDE_SUBFIELD 0
+#define SPACING_SUBFIELD 0
#define LBOUND_SUBFIELD 1
#define UBOUND_SUBFIELD 2
@@ -303,6 +304,27 @@ conv_span_set (stmtblock_t *block, tree desc, tree value)
gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
}
+tree
+get_align (tree desc)
+{
+ tree field = get_component (desc, ALIGN_FIELD);
+ gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
+ return field;
+}
+
+tree
+conv_align_get (tree desc)
+{
+ return non_lvalue_loc (input_location, get_align (desc));
+}
+
+void
+conv_align_set (stmtblock_t *block, tree desc, tree value)
+{
+ tree t = get_align (desc);
+ gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
+}
+
tree
get_rank (tree desc)
{
@@ -510,7 +532,7 @@ get_dimension (tree desc, tree dim)
tmp = get_dimensions (desc);
- return gfc_build_array_ref (tmp, dim, NULL_TREE, true);
+ return gfc_build_array_ref (tmp, dim, true);
}
tree
@@ -573,15 +595,15 @@ get_subfield (tree desc, tree dim, unsigned field_idx)
}
tree
-get_stride (tree desc, tree dim)
+get_spacing (tree desc, tree dim)
{
- tree field = get_subfield (desc, dim, STRIDE_SUBFIELD);
+ tree field = get_subfield (desc, dim, SPACING_SUBFIELD);
gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
return field;
}
tree
-conv_stride_get (tree desc, tree dim)
+conv_spacing_get (tree desc, tree dim)
{
tree type = TREE_TYPE (desc);
gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
@@ -592,20 +614,46 @@ 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 fold_build2_loc (input_location, EXACT_DIV_EXPR,
+ gfc_array_index_type, conv_span_get (desc),
+ GFC_TYPE_ARRAY_ALIGN (TREE_TYPE (desc)));
- return non_lvalue_loc (input_location, get_stride (desc, dim));
+ return non_lvalue_loc (input_location, get_spacing (desc, dim));
}
void
-conv_stride_set (stmtblock_t *block, tree desc, tree dim, tree value)
+conv_spacing_set (stmtblock_t *block, tree desc, tree dim, tree value)
{
location_t loc = input_location;
- tree t = get_stride (desc, dim);
+ tree t = get_spacing (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 spacing = conv_spacing_get (desc, dim);
+ tree align = conv_align_get (desc);
+ tree len = conv_elem_len_get (desc);
+ return fold_build2_loc (input_location, EXACT_DIV_EXPR, gfc_array_index_type,
+ fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, spacing,
+ align),
+ len);
+}
+
tree
get_lbound (tree desc, tree dim)
{
@@ -727,6 +775,26 @@ gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc, tree value)
return gfc_descriptor::conv_span_set (block, desc, value);
}
+tree
+gfc_conv_descriptor_align_get (tree desc)
+{
+ return gfc_descriptor::conv_align_get (desc);
+}
+
+static void
+gfc_conv_descriptor_align_set (stmtblock_t *block, tree desc, tree value)
+{
+ return gfc_descriptor::conv_align_set (block, desc, value);
+}
+
+static void
+gfc_conv_descriptor_align_set (stmtblock_t *block, tree desc, int value)
+{
+ return gfc_conv_descriptor_align_set (block, desc,
+ build_int_cst (gfc_array_index_type,
+ value));
+}
+
tree
gfc_conv_descriptor_dimension_get (tree desc, tree dim)
{
@@ -844,16 +912,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_spacing_get (tree desc, tree dim)
{
- return gfc_descriptor::conv_stride_get (desc, dim);
+ return gfc_descriptor::conv_spacing_get (desc, dim);
}
void
-gfc_conv_descriptor_stride_set (stmtblock_t *block, tree desc,
+gfc_conv_descriptor_spacing_set (stmtblock_t *block, tree desc,
tree dim, tree value)
{
- gfc_descriptor::conv_stride_set (block, desc, dim, value);
+ gfc_descriptor::conv_spacing_set (block, desc, dim, value);
}
tree
@@ -929,13 +997,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 +2006,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 spacing, tree lbound_diff,
+ tree *offset, tree *next_spacing, bool spacing_unchanged)
{
/* Stabilize values in case the expressions depend on the existing bounds. */
lbound = fold_convert (gfc_array_index_type, lbound);
@@ -1952,8 +2016,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);
+ spacing = fold_convert (gfc_array_index_type, spacing);
+ spacing = gfc_evaluate_now (spacing, block);
lbound_diff = fold_convert (gfc_array_index_type, lbound_diff);
lbound_diff = gfc_evaluate_now (lbound_diff, block);
@@ -1962,40 +2026,39 @@ 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 (!spacing_unchanged)
+ gfc_conv_descriptor_spacing_set (block, desc, gfc_rank_cst[dim], spacing);
- if (!offset && !next_stride)
+ if (!offset && !next_spacing)
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, spacing);
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_spacing)
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_spacing = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, spacing, 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 spacing, 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, spacing, lbound,
+ offset, next_sm, false);
}
@@ -2011,7 +2074,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 spacing = gfc_conv_descriptor_spacing_get (from_desc, gfc_rank_cst[dim]);
tree diff;
if (zero_based)
@@ -2029,7 +2092,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, spacing, diff,
offset, nullptr, from_desc == to_desc);
}
@@ -2375,6 +2438,9 @@ gfc_conv_remap_descriptor (stmtblock_t *block, tree dest, tree src,
}
gfc_conv_descriptor_span_set (block, dest, span);
+ gfc_conv_descriptor_align_set (block, dest,
+ gfc_conv_descriptor_align_get (dest));
+
/* Copy offset but adjust it such that it would correspond
to a lbound of zero. */
tree offset;
@@ -2385,13 +2451,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 spacing = gfc_conv_descriptor_spacing_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, spacing, lbound);
offs = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type, offs, tmp);
}
@@ -2399,7 +2462,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 spacing = gfc_conv_descriptor_spacing_get (src, gfc_rank_cst[0]);
int last_dim = dest_rank - 1;
for (int dim = 0; dim < dest_rank; ++dim)
{
@@ -2418,8 +2481,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);
+ spacing, &offset,
+ dim < last_dim ? &spacing : nullptr);
}
gfc_conv_descriptor_offset_set (block, dest, offset);
}
@@ -2476,6 +2539,9 @@ gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src,
else
tmp2 = gfc_get_array_span (src, src_expr);
gfc_conv_descriptor_span_set (block, dest, tmp2);
+
+ gfc_conv_descriptor_align_set (block, dest,
+ gfc_conv_descriptor_align_get (src));
}
@@ -2485,12 +2551,15 @@ 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_type = gfc_get_element_type (TREE_TYPE (desc));
+ tree elem_len = TYPE_SIZE_UNIT (elem_type);
+ elem_len = fold_convert (gfc_array_index_type, elem_len);
+ gfc_conv_descriptor_span_set (block, desc, elem_len);
+
+ gfc_conv_descriptor_align_set (block, desc, TYPE_ALIGN_UNIT (elem_type));
/* 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 +2580,13 @@ 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 spacing = gfc_create_var (gfc_array_index_type, "spacing");
tree offset = gfc_create_var (gfc_array_index_type, "offset");
- gfc_add_modify (block, stride, gfc_index_one_node);
+ tmp = fold_build2_loc (input_location, EXACT_DIV_EXPR,
+ gfc_array_index_type, elem_len,
+ build_int_cst (gfc_array_index_type,
+ TYPE_ALIGN_UNIT (elem_type)));
+ gfc_add_modify (block, spacing, tmp);
gfc_add_modify (block, offset, gfc_index_zero_node);
/* Loop body. */
@@ -2523,9 +2596,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 spacing. */
gfc_conv_descriptor_lbound_set (&body, desc, dim, gfc_index_one_node);
- gfc_conv_descriptor_stride_set (&body, desc, dim, stride);
+ gfc_conv_descriptor_spacing_set (&body, desc, dim, spacing);
gfc_conv_expr (&shapese, shape);
gfc_add_block_to_block (&body, &shapese.pre);
@@ -2535,11 +2608,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, spacing));
+ /* Update spacing. */
+ gfc_add_modify (&body, spacing,
fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, stride,
+ gfc_array_index_type, spacing,
fold_convert (gfc_array_index_type,
shapese.expr)));
/* Finish scalarization loop. */
@@ -2594,24 +2667,26 @@ 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 spacing0 =
+ gfc_conv_descriptor_spacing_get (rhs_desc, gfc_index_zero_node);
+ size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ size, spacing0);
gfc_conv_descriptor_ubound_set (&block, arr, gfc_index_zero_node, size);
- gfc_conv_descriptor_stride_set (
- &block, arr, gfc_index_zero_node,
- gfc_conv_descriptor_stride_get (rhs_desc, gfc_index_zero_node));
+ gfc_conv_descriptor_spacing_set ( &block, arr, gfc_index_zero_node, spacing0);
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_spacing_set (&block, arr, gfc_rank_cst[i], size);
}
gfc_conv_descriptor_dtype_set (&block, arr,
gfc_conv_descriptor_dtype_get (rhs_desc));
tree rank_value = build_int_cst (signed_char_type_node, lhs_rank);
gfc_conv_descriptor_rank_set (&block, arr, rank_value);
- gfc_conv_descriptor_span_set (&block, arr,
- gfc_conv_descriptor_span_get (arr));
+ gfc_conv_descriptor_align_set (&block, arr,
+ gfc_conv_descriptor_align_get (rhs_desc));
gfc_conv_descriptor_offset_set (&block, arr, gfc_index_zero_node);
desc = arr;
}
@@ -2628,6 +2703,8 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
{
tree tmp = gfc_get_cfi_desc_base_addr (cfi);
gfc_conv_descriptor_data_set (unconditional_block, gfc, tmp);
+ gfc_conv_descriptor_align_set (unconditional_block, gfc,
+ GFC_TYPE_ARRAY_ALIGN (TREE_TYPE (gfc)));
if (init_static)
{
@@ -2766,6 +2843,9 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
}
gfc_conv_descriptor_span_set (conditional_block, gfc, tmp);
+ gfc_conv_descriptor_align_set (conditional_block, gfc,
+ TYPE_ALIGN (gfc_get_element_type (TREE_TYPE (gfc))));
+
/* Calculate offset + set lbound, ubound and stride. */
gfc_conv_descriptor_offset_set (conditional_block, gfc, gfc_index_zero_node);
if (gfc_sym
@@ -2814,33 +2894,36 @@ 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].spacing
+ = idx == 0 ? cfi->elem_len / gfc->align : gfc->dim[i-1].spacing * 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_spacing_get (gfc, tmp);
tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp2),
tmp2, tmp);
+ tmp2 = fold_build2_loc (input_location, EXACT_DIV_EXPR, gfc_array_index_type,
+ gfc_get_cfi_desc_elem_len (cfi),
+ fold_convert_loc (input_location, gfc_array_index_type,
+ GFC_TYPE_ARRAY_ALIGN (gfc)));
tmp = build3_loc (input_location, COND_EXPR, gfc_array_index_type, cond,
- gfc_index_one_node, tmp);
+ tmp2, 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->dim[i].spacing = cfi->dim[i].sm / gfc->align */
+ tmp = fold_build2_loc (input_location, EXACT_DIV_EXPR,
+ gfc_array_index_type,
+ gfc_get_cfi_dim_sm (cfi, idx),
+ GFC_TYPE_ARRAY_ALIGN (TREE_TYPE (gfc)));
}
- gfc_conv_descriptor_stride_set (&loop_body, gfc, idx, tmp);
+ gfc_conv_descriptor_spacing_set (&loop_body, gfc, idx, tmp);
- /* gfc->offset -= gfc->dim[i].stride * gfc->dim[i].lbound. */
+ /* gfc->offset -= gfc->dim[i].spacing * 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_spacing_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 +2941,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 *spacing_suboff, tree *lower_suboff,
tree *upper_suboff)
{
tree field;
@@ -2875,8 +2958,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), SPACING_SUBFIELD);
+ *spacing_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);
@@ -2898,10 +2981,10 @@ gfc_get_descriptor_offsets_for_info (const_tree desc_type, tree *data_off,
void
gfc_set_temporary_descriptor (stmtblock_t *block, tree desc, tree class_src,
- tree elemsize, tree data_ptr,
+ tree elemsize, tree elem_align, tree data_ptr,
tree lbound[GFC_MAX_DIMENSIONS],
tree ubound[GFC_MAX_DIMENSIONS],
- tree stride[GFC_MAX_DIMENSIONS], int rank,
+ tree spacing[GFC_MAX_DIMENSIONS], int rank,
bool omit_bounds, bool rank_changer,
bool shift_bounds)
{
@@ -2937,12 +3020,14 @@ 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);
+ spacing[n], &offset, nullptr);
}
}
gfc_conv_descriptor_span_set (block, desc, elemsize);
-
+
+ gfc_conv_descriptor_align_set (block, desc, elem_align);
+
gfc_conv_descriptor_data_set (block, desc, data_ptr);
/* The offset is zero because we create temporaries with a zero
@@ -3020,6 +3105,9 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree src, gfc_expr *src_expr,
if (tmp)
gfc_conv_descriptor_span_set (block, dest, tmp);
+ tree eltype = gfc_get_element_type (TREE_TYPE (dest));
+ gfc_conv_descriptor_align_set (block, dest, TYPE_ALIGN_UNIT (eltype));
+
/* The following can be somewhat confusing. We have two
descriptors, a new one and the original array.
{dest, parmtype, dim} refer to the new one.
@@ -3044,17 +3132,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 spacing = gfc_conv_array_spacing (src, n);
/* Work out the 1st element in the section. */
tree start;
@@ -3069,16 +3156,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);
+ spacing = gfc_evaluate_now (spacing, 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, spacing);
+ 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 +3199,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 spacing 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]);
+ spacing = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type,
+ spacing, info->stride[n]);
tmp = fold_build2_loc (input_location, MULT_EXPR,
- TREE_TYPE (offset), stride, from);
+ TREE_TYPE (offset), spacing, 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 spacing. */
+ gfc_conv_descriptor_spacing_set (block, dest, gfc_rank_cst[dim], spacing);
}
for (int n = rank; n < rank + corank; n++)
@@ -3141,7 +3227,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 +3296,7 @@ gfc_descr_init_count (tree descriptor, int rank, int corank, gfc_expr ** lower,
tree size;
tree offset;
tree stride;
+ tree spacing;
tree cond;
gfc_expr *ubound;
gfc_se se;
@@ -3220,6 +3307,9 @@ gfc_descr_init_count (tree descriptor, int rank, int corank, gfc_expr ** lower,
stride = gfc_index_one_node;
offset = gfc_index_zero_node;
+ gfc_conv_descriptor_align_set (descriptor_block, descriptor,
+ GFC_TYPE_ARRAY_ALIGN (type));
+
/* Set the dtype before the alloc, because registration of coarrays needs
it initialized. */
if (expr->ts.type == BT_CHARACTER
@@ -3265,6 +3355,11 @@ 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;
+ spacing = gfc_conv_descriptor_elem_len_get (descriptor);
+ spacing = fold_convert_loc (input_location, gfc_array_index_type, spacing);
+ spacing = fold_build2_loc (input_location, EXACT_DIV_EXPR,
+ gfc_array_index_type, spacing,
+ GFC_TYPE_ARRAY_ALIGN (type));
for (n = 0; n < rank; n++)
{
@@ -3313,7 +3408,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, spacing);
offset = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, offset, tmp);
@@ -3352,9 +3447,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 spacing. */
+ gfc_conv_descriptor_spacing_set (descriptor_block, descriptor,
+ gfc_rank_cst[n], spacing);
/* Calculate size and check whether extent is negative. */
size = gfc_conv_array_extent_dim (conv_lbound, conv_ubound,
@@ -3372,7 +3467,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, spacing),
PRED_FORTRAN_OVERFLOW);
tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond,
integer_one_node, integer_zero_node);
@@ -3390,6 +3485,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);
+
+ spacing = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, spacing, size);
+ spacing = gfc_evaluate_now (spacing, pblock);
}
for (n = rank; n < rank + corank; n++)
@@ -3441,6 +3540,9 @@ gfc_descr_init_count (tree descriptor, int rank, int corank, gfc_expr ** lower,
tmp = fold_convert (gfc_array_index_type, element_size);
gfc_conv_descriptor_span_set (descriptor_block, descriptor, tmp);
+ gfc_conv_descriptor_align_set (descriptor_block, descriptor,
+ TYPE_ALIGN_UNIT(gfc_get_element_type (TREE_TYPE (descriptor))));
+
return gfc_evaluate_now (stride, pblock);
}
@@ -3479,15 +3581,18 @@ gfc_set_contiguous_array (stmtblock_t *block, tree desc, tree size,
tree data_ptr)
{
tree dtype_value = gfc_get_dtype_rank_type (1, TREE_TYPE (desc));
+ gfc_conv_descriptor_align_set (block, desc,
+ GFC_TYPE_ARRAY_ALIGN (TREE_TYPE (desc)));
gfc_conv_descriptor_dtype_set (block, desc, dtype_value);
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_ubound_set (block, desc,
- gfc_index_zero_node, size);
+ tree span = gfc_conv_descriptor_span_get (desc);
+ tree spacing = fold_build2_loc (input_location, EXACT_DIV_EXPR,
+ gfc_array_index_type, span,
+ GFC_TYPE_ARRAY_ALIGN (TREE_TYPE (desc)));
+ gfc_conv_descriptor_spacing_set (block, desc, gfc_index_zero_node, spacing);
+ gfc_conv_descriptor_ubound_set (block, desc, gfc_index_zero_node, size);
gfc_conv_descriptor_data_set (block, desc, data_ptr);
}
@@ -3566,7 +3671,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_spacing_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 +3691,7 @@ get_std_lbound (gfc_expr *expr, tree desc, int dim, bool assumed_size)
{
tree lbound;
tree ubound;
- tree stride;
+ tree spacing;
tree cond, cond1, cond3, cond4;
tree tmp;
gfc_ref *ref;
@@ -3596,15 +3701,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);
+ spacing = gfc_conv_descriptor_spacing_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);
+ spacing, 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);
+ spacing, 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 +3785,9 @@ 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 = fold_build2_loc (input_location, EXACT_DIV_EXPR,
+ gfc_array_index_type, elemsize2,
+ GFC_TYPE_ARRAY_ALIGN (TREE_TYPE (desc)));
tree offset = gfc_index_zero_node;
for (int n = 0; n < expr2->rank; n++)
@@ -3705,15 +3812,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_spacing_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,
@@ -3731,7 +3832,11 @@ gfc_set_descriptor_for_assign_realloc (stmtblock_t *block, gfc_loopinfo *loop,
gfc_conv_descriptor_offset_set (block, desc, offset);
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
- gfc_conv_descriptor_span_set (block, desc, elemsize2);
+ {
+ gfc_conv_descriptor_span_set (block, desc, elemsize2);
+ gfc_conv_descriptor_align_set (block, desc,
+ GFC_TYPE_ARRAY_ALIGN (TREE_TYPE (desc)));
+ }
/* For deferred character length, the 'size' field of the dtype might
have changed so set the dtype. */
@@ -3811,7 +3916,13 @@ 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_align_set (block, desc,
+ GFC_TYPE_ARRAY_ALIGN (TREE_TYPE (desc)));
+ gfc_conv_descriptor_dtype_set (block, desc,
+ gfc_get_dtype (TREE_TYPE (desc)));
+ tree size = gfc_conv_descriptor_elem_len_get (desc);
+ size = fold_build2_loc (input_location, EXACT_DIV_EXPR, gfc_array_index_type,
+ desc, GFC_TYPE_ARRAY_ALIGN (TREE_TYPE (desc)));
tree offset = gfc_index_zero_node;
for (int i = 0; i < as->rank; i++)
{
@@ -3830,30 +3941,17 @@ 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);
size = gfc_evaluate_now (size, block);
- offset = fold_build2_loc (input_location,
- MINUS_EXPR,
- gfc_array_index_type,
- offset, size);
+ gfc_conv_descriptor_spacing_set (block, desc, gfc_rank_cst[i], 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,
- upper, lower);
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type,
- tmp, gfc_index_one_node);
+ tree tmp = gfc_conv_array_extent_dim (lower, upper, nullptr);
size = fold_build2_loc (input_location, MULT_EXPR,
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-descriptor.h b/gcc/fortran/trans-descriptor.h
index b991d2a41895..5f1d7f3f17b9 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -41,6 +41,7 @@ void gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src,
tree gfc_conv_descriptor_data_get (tree);
tree gfc_conv_descriptor_offset_get (tree);
tree gfc_conv_descriptor_span_get (tree);
+tree gfc_conv_descriptor_align_get (tree);
tree gfc_conv_descriptor_dtype_get (tree);
tree gfc_conv_descriptor_rank_get (tree);
tree gfc_conv_descriptor_elem_len_get (tree);
@@ -54,7 +55,7 @@ tree gfc_conv_descriptor_stride_get (tree, tree);
tree gfc_conv_descriptor_lbound_get (tree, tree);
tree gfc_conv_descriptor_ubound_get (tree, tree);
tree gfc_conv_descriptor_extent_get (tree, tree);
-tree gfc_conv_descriptor_sm_get (tree, tree);
+tree gfc_conv_descriptor_spacing_get (tree, tree);
tree gfc_conv_descriptor_token_get (tree);
tree gfc_conv_descriptor_token_field (tree);
@@ -84,7 +85,7 @@ void gfc_conv_shift_descriptor (stmtblock_t*, tree, tree, int, tree);
void gfc_conv_shift_descriptor_subarray (stmtblock_t*, tree, gfc_expr *, gfc_expr *);
void gfc_conv_shift_descriptor (stmtblock_t *, tree, int, tree *, tree *);
-void gfc_set_temporary_descriptor (stmtblock_t *, tree, tree, tree, tree,
+void gfc_set_temporary_descriptor (stmtblock_t *, tree, tree, tree, tree, tree,
tree[GFC_MAX_DIMENSIONS], tree[GFC_MAX_DIMENSIONS],
tree[GFC_MAX_DIMENSIONS], int, bool, bool, bool);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 016ebdb6a7b0..192152b48ff1 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -1629,7 +1629,9 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
tmp = gfc_conv_array_data (to);
tmp = build_fold_indirect_ref_loc (input_location, tmp);
to_ref = gfc_build_addr_expr (NULL_TREE,
- gfc_build_array_ref (tmp, index, to));
+ gfc_build_array_ref (tmp, index, false,
+ GFC_TYPE_ARRAY_SPACING (to, 0),
+ GFC_TYPE_ARRAY_ALIGN (to)));
}
vec_safe_push (args, to_ref);
@@ -2785,7 +2787,7 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
/* For BIND(C), a BT_CHARACTER is not an ARRAY_TYPE. */
if (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE)
{
- tmp = gfc_build_array_ref (tmp, start.expr, NULL_TREE, true);
+ tmp = gfc_build_array_ref (tmp, start.expr, true);
se->expr = gfc_build_addr_expr (type, tmp);
}
else if (POINTER_TYPE_P (TREE_TYPE (tmp)))
@@ -4816,7 +4818,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_SPACING (type, n) = gfc_conv_array_spacing (desc, n);
if (GFC_TYPE_ARRAY_LBOUND (type, n) == NULL_TREE)
{
GFC_TYPE_ARRAY_LBOUND (type, n)
@@ -4838,7 +4840,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_SPACING (type, n));
offset = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, offset, tmp);
}
@@ -5355,8 +5357,6 @@ gfc_conv_subref_array_arg (gfc_se *se, gfc_expr * expr, int g77,
gfc_loopinfo loop;
gfc_loopinfo loop2;
gfc_array_info *info;
- tree offset;
- tree tmp_index;
tree tmp;
tree base_type;
stmtblock_t body;
@@ -5511,55 +5511,9 @@ gfc_conv_subref_array_arg (gfc_se *se, gfc_expr * expr, int g77,
gfc_mark_ss_chain_used (lss, 1);
gfc_mark_ss_chain_used (loop.temp_ss, 1);
- /* Declare the variable to hold the temporary offset and start the
- scalarized loop body. */
- offset = gfc_create_var (gfc_array_index_type, NULL);
gfc_start_scalarized_body (&loop2, &body);
- /* Build the offsets for the temporary from the loop variables. The
- temporary array has lbounds of zero and strides of one in all
- dimensions, so this is very simple. The offset is only computed
- outside the innermost loop, so the overall transfer could be
- optimized further. */
- info = &rse.ss->info->data.array;
-
- tmp_index = gfc_index_zero_node;
- for (n = dimen - 1; n > 0; n--)
- {
- tree tmp_str;
- tmp = rse.loop->loopvar[n];
- tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- tmp, rse.loop->from[n]);
- tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
- tmp, tmp_index);
-
- tmp_str = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- rse.loop->to[n-1], rse.loop->from[n-1]);
- tmp_str = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type,
- tmp_str, gfc_index_one_node);
-
- tmp_index = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, tmp, tmp_str);
- }
-
- tmp_index = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- tmp_index, rse.loop->from[0]);
- gfc_add_modify (&rse.loop->code[0], offset, tmp_index);
-
- tmp_index = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type,
- rse.loop->loopvar[0], offset);
-
- /* Now use the offset for the reference. */
- tmp = build_fold_indirect_ref_loc (input_location,
- info->data);
- rse.expr = gfc_build_array_ref (tmp, tmp_index, NULL);
-
- if (expr->ts.type == BT_CHARACTER)
- rse.string_length = expr->ts.u.cl->backend_decl;
+ gfc_conv_tmp_array_ref (&rse);
gfc_conv_expr (&lse, expr);
@@ -6263,7 +6217,9 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
tmp = gfc_conv_descriptor_extent_get (gfc, idx);
gfc_add_modify (&loop_body, gfc_get_cfi_dim_extent (cfi, idx), tmp);
/* d->dim[n].sm = gfc->dim[i].stride * gfc->span); */
- tmp = gfc_conv_descriptor_sm_get (gfc, idx);
+ tmp = gfc_conv_descriptor_spacing_get (gfc, idx);
+ tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ tmp, gfc_conv_descriptor_align_get (gfc));
gfc_add_modify (&loop_body, gfc_get_cfi_dim_sm (cfi, idx), tmp);
/* Generate loop. */
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index c9eee7656d28..c60ec1d0d0e0 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -2162,7 +2162,9 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
thus we need explicitly check this - and return 0 if they are exceeded. */
lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[rank+corank-1]);
- tmp = gfc_build_array_ref (subdesc, gfc_rank_cst[corank-1], NULL);
+ tmp = gfc_build_array_ref (subdesc, gfc_rank_cst[corank-1], false,
+ GFC_TYPE_ARRAY_SPACING (subse.expr, 0),
+ GFC_TYPE_ARRAY_ALIGN (subse.expr));
invalid_bound = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
fold_convert (gfc_array_index_type, tmp),
lbound);
@@ -2171,7 +2173,9 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
{
lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[codim]);
ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[codim]);
- tmp = gfc_build_array_ref (subdesc, gfc_rank_cst[codim-rank], NULL);
+ tmp = gfc_build_array_ref (subdesc, gfc_rank_cst[codim-rank], false,
+ GFC_TYPE_ARRAY_SPACING (subse.expr, 0),
+ GFC_TYPE_ARRAY_ALIGN (subse.expr));
cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
fold_convert (gfc_array_index_type, tmp),
lbound);
@@ -2191,7 +2195,9 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
/* coindex = sub(corank) - lcobound(n). */
coindex = fold_convert (gfc_array_index_type,
gfc_build_array_ref (subdesc, gfc_rank_cst[corank-1],
- NULL));
+ false,
+ GFC_TYPE_ARRAY_SPACING (subse.expr, 0),
+ GFC_TYPE_ARRAY_ALIGN (subse.expr)));
lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[rank+corank-1]);
coindex = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
fold_convert (gfc_array_index_type, coindex),
@@ -2209,7 +2215,9 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
gfc_array_index_type, coindex, extent);
/* coindex += sub(codim). */
- tmp = gfc_build_array_ref (subdesc, gfc_rank_cst[codim-rank], NULL);
+ tmp = gfc_build_array_ref (subdesc, gfc_rank_cst[codim-rank], false,
+ GFC_TYPE_ARRAY_SPACING (subse.expr, 0),
+ GFC_TYPE_ARRAY_ALIGN (subse.expr));
coindex = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type, coindex,
fold_convert (gfc_array_index_type, tmp));
@@ -2310,7 +2318,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;
@@ -2348,19 +2356,21 @@ 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 spacing = gfc_conv_descriptor_spacing_get (desc, gfc_rank_cst[0]);
+ tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ spacing, gfc_conv_descriptor_align_get (desc));
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
- stride, build_int_cst (TREE_TYPE (stride), 1));
+ tmp, 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_spacing_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]);
+ spacing = gfc_conv_descriptor_spacing_get (desc, gfc_rank_cst[i+1]);
tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
- stride, tmp);
+ spacing, tmp);
cond = fold_build2_loc (input_location, TRUTH_AND_EXPR,
boolean_type_node, cond, tmp);
}
@@ -2737,34 +2747,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)
{
@@ -5546,8 +5528,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
for (int i = 0; i < arrayexpr->rank; i++)
{
tree res_idx = build_int_cst (gfc_array_index_type, i);
- tree res_arr_ref = gfc_build_array_ref (result_var, res_idx,
- NULL_TREE, true);
+ tree res_arr_ref = gfc_build_array_ref (result_var, res_idx, true);
tree value = convert (type, pos[i]);
gfc_add_modify (&se->pre, res_arr_ref, value);
@@ -9016,7 +8997,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_spacing_get (arg1se.expr, tmp);
if (arg2->expr->rank != 0)
nonzero_arraylen = fold_build2_loc (input_location, NE_EXPR,
logical_type_node, tmp,
@@ -11280,10 +11261,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..44e65d9e01d2 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,40 @@ 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 spacing = gfc_conv_array_spacing (array, rank);
+ tree tmp = gfc_conv_array_extent (array, rank);
+ full_size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, tmp, spacing);
+ full_size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, full_size,
+ GFC_TYPE_ARRAY_ALIGN (type));
}
- 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 +806,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);
@@ -1657,7 +1655,9 @@ nml_get_addr_expr (gfc_symbol * sym, gfc_component * c,
tmp = gfc_build_addr_expr (NULL_TREE, tmp);
if (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE)
- tmp = gfc_build_array_ref (tmp, gfc_index_zero_node, NULL);
+ tmp = gfc_build_array_ref (tmp, gfc_index_zero_node, false,
+ GFC_TYPE_ARRAY_SPACING (tmp, 0),
+ GFC_TYPE_ARRAY_ALIGN (tmp));
if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
tmp = build_fold_indirect_ref_loc (input_location,
@@ -1823,7 +1823,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_spacing (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 5e70383089f1..62245e7d5f00 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -644,13 +644,17 @@ gfc_walk_alloc_comps (tree decl, tree dest, tree var,
gfc_init_block (&tmpblock);
tem = gfc_conv_array_data (decl);
tree declvar = build_fold_indirect_ref_loc (input_location, tem);
- tree declvref = gfc_build_array_ref (declvar, index, NULL);
+ tree declvref = gfc_build_array_ref (declvar, index, false,
+ GFC_TYPE_ARRAY_SPACING (declvar, 0),
+ GFC_TYPE_ARRAY_ALIGN (declvar));
tree destvar, destvref = NULL_TREE;
if (dest)
{
tem = gfc_conv_array_data (dest);
destvar = build_fold_indirect_ref_loc (input_location, tem);
- destvref = gfc_build_array_ref (destvar, index, NULL);
+ destvref = gfc_build_array_ref (destvar, index, false,
+ GFC_TYPE_ARRAY_SPACING (declvar, 0),
+ GFC_TYPE_ARRAY_ALIGN (declvar));
}
gfc_add_expr_to_block (&tmpblock,
gfc_walk_alloc_comps (declvref, destvref,
@@ -830,17 +834,18 @@ gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer)
gfc_add_modify (&cond_block, decl, outer);
tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
size = gfc_conv_descriptor_extent_get (decl, rank);
+ tree spacing;
if (GFC_TYPE_ARRAY_RANK (type) >= 1)
- size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size,
- gfc_conv_descriptor_sm_get (decl, rank));
+ spacing = gfc_conv_descriptor_spacing_get (decl, rank);
else
{
tree esize = gfc_conv_descriptor_span_get (decl);
- esize = fold_convert_loc (input_location, gfc_array_index_type, esize);
- size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- size, esize);
+ spacing = fold_convert_loc (input_location, gfc_array_index_type, esize);
}
+ size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ size, spacing);
+ size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ size, gfc_conv_descriptor_align_get (decl));
size = unshare_expr (size);
size = gfc_evaluate_now (fold_convert (size_type_node, size),
&cond_block);
@@ -1019,17 +1024,16 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
{
tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
size = gfc_conv_descriptor_extent_get (dest, rank);
+ tree spacing;
if (GFC_TYPE_ARRAY_RANK (type) >= 1)
- size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size,
- gfc_conv_descriptor_sm_get (dest, rank));
+ spacing = gfc_conv_descriptor_spacing_get (dest, rank);
else
{
tree esize = gfc_conv_descriptor_span_get (dest);
- esize = fold_convert_loc (input_location, gfc_array_index_type, esize);
- size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- size, esize);
+ spacing = fold_convert_loc (input_location, gfc_array_index_type, esize);
}
+ size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ size, spacing);
size = unshare_expr (size);
size = gfc_evaluate_now (fold_convert (size_type_node, size),
&cond_block);
@@ -1140,17 +1144,21 @@ gfc_omp_clause_assign_op (tree clause, tree dest, tree src)
{
tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
size = gfc_conv_descriptor_extent_get (src, rank);
+ tree spacing;
if (GFC_TYPE_ARRAY_RANK (type) >= 1)
- size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size,
- gfc_conv_descriptor_sm_get (src, rank));
+ {
+ spacing = gfc_conv_descriptor_spacing_get (src, rank);
+ spacing = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, spacing,
+ gfc_conv_descriptor_align_get (src));
+ }
else
{
tree esize = gfc_conv_descriptor_span_get (src);
- esize = fold_convert_loc (input_location, gfc_array_index_type, esize);
- size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- size, esize);
+ spacing = fold_convert_loc (input_location, gfc_array_index_type, esize);
}
+ size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ size, spacing);
size = unshare_expr (size);
size = gfc_evaluate_now (fold_convert (size_type_node, size),
&cond_block);
@@ -1279,8 +1287,12 @@ gfc_omp_linear_clause_add_loop (stmtblock_t *block, tree dest, tree src,
gfc_init_block (&tmpblock);
if (TREE_CODE (TREE_TYPE (dest)) == ARRAY_TYPE)
{
- desta = gfc_build_array_ref (dest, index, NULL);
- srca = gfc_build_array_ref (src, index, NULL);
+ desta = gfc_build_array_ref (dest, index, false,
+ GFC_TYPE_ARRAY_SPACING (dest, 0),
+ GFC_TYPE_ARRAY_ALIGN (dest));
+ srca = gfc_build_array_ref (src, index, false,
+ GFC_TYPE_ARRAY_SPACING (src, 0),
+ GFC_TYPE_ARRAY_ALIGN (src));
}
else
{
@@ -2676,7 +2688,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_SPACING (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-stmt.cc b/gcc/fortran/trans-stmt.cc
index 513eaa5f84d4..f67ece3de5b3 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -506,7 +506,7 @@ gfc_trans_call (gfc_code * code, bool dependency_check,
{
/* Form the mask expression according to the mask. */
index = count1;
- maskexpr = gfc_build_array_ref (mask, index, NULL);
+ maskexpr = gfc_build_array_ref (mask, index, true);
if (invert)
maskexpr = fold_build1_loc (input_location, TRUTH_NOT_EXPR,
TREE_TYPE (maskexpr), maskexpr);
@@ -4366,7 +4366,7 @@ gfc_trans_nested_forall_loop (forall_info * nested_forall_info, tree body,
/* If a mask was specified make the assignment conditional. */
if (mask)
{
- tmp = gfc_build_array_ref (mask, maskindex, NULL);
+ tmp = gfc_build_array_ref (mask, maskindex, true);
body = build3_v (COND_EXPR, tmp, body,
build_empty_stmt (input_location));
}
@@ -4443,7 +4443,7 @@ generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree count3,
{
gfc_init_block (&body1);
gfc_conv_expr (&lse, expr);
- rse.expr = gfc_build_array_ref (tmp1, count1, NULL);
+ rse.expr = gfc_build_array_ref (tmp1, count1, true);
}
else
{
@@ -4466,7 +4466,7 @@ generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree count3,
gfc_conv_expr (&lse, expr);
/* Form the expression of the temporary. */
- rse.expr = gfc_build_array_ref (tmp1, count1, NULL);
+ rse.expr = gfc_build_array_ref (tmp1, count1, true);
}
/* Use the scalar assignment. */
@@ -4477,7 +4477,7 @@ generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree count3,
/* Form the mask expression according to the mask tree list. */
if (wheremask)
{
- wheremaskexpr = gfc_build_array_ref (wheremask, count3, NULL);
+ wheremaskexpr = gfc_build_array_ref (wheremask, count3, true);
if (invert)
wheremaskexpr = fold_build1_loc (input_location, TRUTH_NOT_EXPR,
TREE_TYPE (wheremaskexpr),
@@ -4548,7 +4548,7 @@ generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree count3,
{
gfc_init_block (&body1);
gfc_conv_expr (&rse, expr2);
- lse.expr = gfc_build_array_ref (tmp1, count1, NULL);
+ lse.expr = gfc_build_array_ref (tmp1, count1, true);
}
else
{
@@ -4572,7 +4572,7 @@ generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree count3,
gfc_conv_expr (&rse, expr2);
/* Form the expression of the temporary. */
- lse.expr = gfc_build_array_ref (tmp1, count1, NULL);
+ lse.expr = gfc_build_array_ref (tmp1, count1, true);
}
/* Use the scalar assignment. */
@@ -4583,7 +4583,7 @@ generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree count3,
/* Form the mask expression according to the mask tree list. */
if (wheremask)
{
- wheremaskexpr = gfc_build_array_ref (wheremask, count3, NULL);
+ wheremaskexpr = gfc_build_array_ref (wheremask, count3, true);
if (invert)
wheremaskexpr = fold_build1_loc (input_location, TRUTH_NOT_EXPR,
TREE_TYPE (wheremaskexpr),
@@ -4989,7 +4989,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
inner_size, NULL, block, &ptemp1);
gfc_start_block (&body);
gfc_init_se (&lse, NULL);
- lse.expr = gfc_build_array_ref (tmp1, count, NULL);
+ lse.expr = gfc_build_array_ref (tmp1, count, true);
gfc_init_se (&rse, NULL);
rse.want_pointer = 1;
gfc_conv_expr (&rse, expr2);
@@ -5016,7 +5016,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
gfc_start_block (&body);
gfc_init_se (&lse, NULL);
gfc_init_se (&rse, NULL);
- rse.expr = gfc_build_array_ref (tmp1, count, NULL);
+ rse.expr = gfc_build_array_ref (tmp1, count, true);
lse.want_pointer = 1;
gfc_conv_expr (&lse, expr1);
gfc_add_block_to_block (&body, &lse.pre);
@@ -5059,7 +5059,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
inner_size, NULL, block, &ptemp1);
gfc_start_block (&body);
gfc_init_se (&lse, NULL);
- lse.expr = gfc_build_array_ref (tmp1, count, NULL);
+ lse.expr = gfc_build_array_ref (tmp1, count, true);
lse.direct_byref = 1;
gfc_conv_expr_descriptor (&lse, expr2);
@@ -5081,7 +5081,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
/* Reset count. */
gfc_add_modify (block, count, gfc_index_zero_node);
- parm = gfc_build_array_ref (tmp1, count, NULL);
+ parm = gfc_build_array_ref (tmp1, count, true);
gfc_init_se (&lse, NULL);
gfc_conv_expr_descriptor (&lse, expr1);
gfc_add_modify (&lse.pre, lse.expr, parm);
@@ -5475,7 +5475,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
/* Store the mask. */
se.expr = convert (mask_type, se.expr);
- tmp = gfc_build_array_ref (mask, maskindex, NULL);
+ tmp = gfc_build_array_ref (mask, maskindex, true);
gfc_add_modify (&body, tmp, se.expr);
/* Advance to the next mask element. */
@@ -5737,7 +5737,7 @@ gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info,
if (mask && (cmask || pmask))
{
- tmp = gfc_build_array_ref (mask, count, NULL);
+ tmp = gfc_build_array_ref (mask, count, true);
if (invert)
tmp = fold_build1_loc (input_location, TRUTH_NOT_EXPR, mask_type, tmp);
gfc_add_modify (&body1, mtmp, tmp);
@@ -5745,7 +5745,7 @@ gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info,
if (cmask)
{
- tmp1 = gfc_build_array_ref (cmask, count, NULL);
+ tmp1 = gfc_build_array_ref (cmask, count, true);
tmp = cond;
if (mask)
tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR, mask_type,
@@ -5755,7 +5755,7 @@ gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info,
if (pmask)
{
- tmp1 = gfc_build_array_ref (pmask, count, NULL);
+ tmp1 = gfc_build_array_ref (pmask, count, true);
tmp = fold_build1_loc (input_location, TRUTH_NOT_EXPR, mask_type, cond);
if (mask)
tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR, mask_type, mtmp,
@@ -5914,7 +5914,7 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2,
/* Form the mask expression according to the mask. */
index = count1;
- maskexpr = gfc_build_array_ref (mask, index, NULL);
+ maskexpr = gfc_build_array_ref (mask, index, true);
if (invert)
maskexpr = fold_build1_loc (input_location, TRUTH_NOT_EXPR,
TREE_TYPE (maskexpr), maskexpr);
@@ -5968,7 +5968,7 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2,
/* Form the mask expression according to the mask tree list. */
index = count2;
- maskexpr = gfc_build_array_ref (mask, index, NULL);
+ maskexpr = gfc_build_array_ref (mask, index, true);
if (invert)
maskexpr = fold_build1_loc (input_location, TRUTH_NOT_EXPR,
TREE_TYPE (maskexpr), maskexpr);
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 9d8de30ff951..9c7cd18ea6d8 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -1491,7 +1491,7 @@ gfc_get_element_type (tree type)
struct descriptor_dimension
{
- index stride;
+ index sm;
index lbound;
index ubound;
}
@@ -1664,9 +1664,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 ("spacing"),
gfc_array_index_type, &chain);
suppress_warning (decl);
@@ -1854,15 +1854,27 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
tree type;
tree tmp;
int n;
- int known_stride;
int known_offset;
mpz_t offset;
mpz_t stride;
+ mpz_t spacing;
mpz_t delta;
gfc_expr *expr;
mpz_init_set_ui (offset, 0);
mpz_init_set_ui (stride, 1);
+ mpz_init (spacing);
+ wide_int align = wi::uhwi (TYPE_ALIGN_UNIT (etype),
+ TYPE_PRECISION (gfc_array_index_type));
+
+ bool known_spacing = INTEGER_CST_P (TYPE_SIZE_UNIT (etype));
+ if (known_spacing)
+ {
+ wide_int elem_len = wi::to_wide (TYPE_SIZE_UNIT (etype));
+ wide_int len_align = wi::udiv_trunc (elem_len, align);
+ gcc_assert (wi::fits_uhwi_p (len_align));
+ mpz_set_ui (spacing, len_align.to_uhwi ());
+ }
mpz_init (delta);
/* We don't use build_array_type because this does not include
@@ -1876,16 +1888,16 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
GFC_ARRAY_TYPE_P (type) = 1;
TYPE_LANG_SPECIFIC (type) = ggc_cleared_alloc<struct lang_type> ();
- known_stride = (packed != PACKED_NO);
+ bool known_stride = (packed != PACKED_NO);
known_offset = 1;
for (n = 0; n < as->rank; n++)
{
- /* Fill in the stride and bound components of the type. */
- if (known_stride)
- tmp = gfc_conv_mpz_to_tree (stride, gfc_index_integer_kind);
+ /* Fill in the spacing and bound components of the type. */
+ if (known_spacing)
+ tmp = gfc_conv_mpz_to_tree (spacing, gfc_index_integer_kind);
else
tmp = NULL_TREE;
- GFC_TYPE_ARRAY_STRIDE (type, n) = tmp;
+ GFC_TYPE_ARRAY_SPACING (type, n) = tmp;
expr = as->lower[n];
if (expr && expr->expr_type == EXPR_CONSTANT)
@@ -1895,15 +1907,16 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
}
else
{
- known_stride = 0;
+ known_stride = false;
+ known_spacing = false;
tmp = NULL_TREE;
}
GFC_TYPE_ARRAY_LBOUND (type, n) = tmp;
- if (known_stride)
+ if (known_spacing)
{
/* Calculate the offset. */
- mpz_mul (delta, stride, as->lower[n]->value.integer);
+ mpz_mul (delta, spacing, as->lower[n]->value.integer);
mpz_sub (offset, offset, delta);
}
else
@@ -1918,22 +1931,29 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
else
{
tmp = NULL_TREE;
- known_stride = 0;
+ known_stride = false;
+ known_spacing = false;
}
GFC_TYPE_ARRAY_UBOUND (type, n) = tmp;
- if (known_stride)
+ if (known_spacing || known_stride)
{
/* Calculate the stride. */
mpz_sub (delta, as->upper[n]->value.integer,
as->lower[n]->value.integer);
mpz_add_ui (delta, delta, 1);
- mpz_mul (stride, stride, delta);
+ if (known_stride)
+ mpz_mul (stride, stride, delta);
+ if (known_spacing)
+ mpz_mul (spacing, spacing, delta);
}
/* Only the first stride is known for partial packed arrays. */
if (packed == PACKED_NO || packed == PACKED_PARTIAL)
- known_stride = 0;
+ {
+ known_stride = 0;
+ known_spacing = 0;
+ }
}
for (n = as->rank; n < as->rank + as->corank; n++)
{
@@ -1971,6 +1991,11 @@ 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);
+
+ wide_int index_one = wi::one (TYPE_PRECISION (gfc_array_index_type));
+ GFC_TYPE_ARRAY_ALIGN (type) = wide_int_to_tree (gfc_array_index_type, align);
GFC_TYPE_ARRAY_RANK (type) = as->rank;
GFC_TYPE_ARRAY_CORANK (type) = as->corank;
GFC_TYPE_ARRAY_DTYPE (type) = NULL_TREE;
@@ -2050,6 +2075,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 (spacing);
mpz_clear (delta);
return type;
@@ -2113,6 +2139,12 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted)
gfc_array_index_type, &chain);
suppress_warning (decl);
+ /* Add the span component. */
+ decl = gfc_add_field_to_struct_1 (fat_type,
+ get_identifier ("align"),
+ gfc_array_index_type, &chain);
+ suppress_warning (decl);
+
/* Build the array type for the stride and bound components. */
if (dimen + codimen > 0)
{
@@ -2199,20 +2231,37 @@ gfc_get_array_type_bounds (tree etype, int dimen, int codimen, tree * lbound,
GFC_DESCRIPTOR_TYPE_P (fat_type) = 1;
TYPE_LANG_SPECIFIC (fat_type) = ggc_cleared_alloc<struct lang_type> ();
+ int index_precision = TYPE_PRECISION (gfc_array_index_type);
+ wide_int align = wi::uhwi (TYPE_ALIGN_UNIT (etype), index_precision);
+ wide_int index_one = wi::one (index_precision);
+ GFC_TYPE_ARRAY_ALIGN (fat_type) = wide_int_to_tree (gfc_array_index_type,
+ align);
GFC_TYPE_ARRAY_RANK (fat_type) = dimen;
GFC_TYPE_ARRAY_CORANK (fat_type) = codimen;
GFC_TYPE_ARRAY_DTYPE (fat_type) = NULL_TREE;
GFC_TYPE_ARRAY_AKIND (fat_type) = akind;
/* Build an array descriptor record type. */
- if (packed != 0)
- stride = gfc_index_one_node;
+ tree spacing;
+ if (packed == 0)
+ {
+ stride = gfc_index_one_node;
+ spacing = TYPE_SIZE_UNIT (etype);
+ if (spacing != NULL_TREE)
+ spacing = fold_build2_loc (input_location, EXACT_DIV_EXPR,
+ gfc_array_index_type, spacing,
+ build_int_cst (gfc_array_index_type,
+ TYPE_ALIGN_UNIT (etype)));
+ }
else
- stride = NULL_TREE;
+ {
+ stride = NULL_TREE;
+ spacing = NULL_TREE;
+ }
for (n = 0; n < dimen + codimen; n++)
{
if (n < dimen)
- GFC_TYPE_ARRAY_STRIDE (fat_type, n) = stride;
+ GFC_TYPE_ARRAY_SPACING (fat_type, n) = spacing;
if (lbound)
lower = lbound[n];
@@ -2242,20 +2291,26 @@ gfc_get_array_type_bounds (tree etype, int dimen, int codimen, tree * lbound,
if (n >= dimen)
continue;
- if (upper != NULL_TREE && lower != NULL_TREE && stride != NULL_TREE)
+ if (upper != NULL_TREE && lower != NULL_TREE
+ && (stride != NULL_TREE || spacing != 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);
- stride = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, tmp, stride);
- /* Check the folding worked. */
- gcc_assert (INTEGER_CST_P (stride));
+ tmp = gfc_conv_array_extent_dim (lower, upper, nullptr);
+ if (stride != NULL_TREE)
+ {
+ stride = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, tmp, stride);
+ /* Check the folding worked. */
+ gcc_assert (INTEGER_CST_P (stride));
+ }
+ if (spacing != NULL_TREE)
+ spacing = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, tmp, spacing);
}
else
- stride = NULL_TREE;
+ {
+ stride = NULL_TREE;
+ spacing = NULL_TREE;
+ }
}
GFC_TYPE_ARRAY_SIZE (fat_type) = stride;
@@ -3833,8 +3888,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, spacing_suboff;
tree dtype, field, rank_off;
if (! GFC_DESCRIPTOR_TYPE_P (type))
@@ -3889,12 +3944,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, &spacing_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);
@@ -3964,9 +4016,10 @@ 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, spacing_suboff));
t = build1 (INDIRECT_REF, gfc_array_index_type, t);
- t = build2 (MULT_EXPR, gfc_array_index_type, t, elem_size);
+ t = build2 (MULT_EXPR, gfc_array_index_type, t,
+ GFC_TYPE_ARRAY_ALIGN (type));
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.cc b/gcc/fortran/trans.cc
index 3ffcbbaccc83..99ea36ead8f7 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -387,81 +387,6 @@ gfc_build_addr_expr (tree type, tree t)
}
-static tree
-get_array_span (tree type, tree decl)
-{
- tree span;
-
- /* Component references are guaranteed to have a reliable value for
- 'span'. Likewise indirect references since they emerge from the
- conversion of a CFI descriptor or the hidden dummy descriptor. */
- if (TREE_CODE (decl) == COMPONENT_REF
- && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
- return gfc_conv_descriptor_span_get (decl);
- else if (INDIRECT_REF_P (decl)
- && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
- return gfc_conv_descriptor_span_get (decl);
-
- /* Return the span for deferred character length array references. */
- if (type
- && (TREE_CODE (type) == ARRAY_TYPE || TREE_CODE (type) == INTEGER_TYPE)
- && TYPE_STRING_FLAG (type))
- {
- if (TREE_CODE (decl) == PARM_DECL)
- decl = build_fold_indirect_ref_loc (input_location, decl);
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
- span = gfc_conv_descriptor_span_get (decl);
- else
- span = gfc_get_character_len_in_bytes (type);
- span = (span && !integer_zerop (span))
- ? (fold_convert (gfc_array_index_type, span)) : (NULL_TREE);
- }
- /* Likewise for class array or pointer array references. */
- else if (TREE_CODE (decl) == FIELD_DECL
- || VAR_OR_FUNCTION_DECL_P (decl)
- || TREE_CODE (decl) == PARM_DECL)
- {
- if (GFC_DECL_CLASS (decl))
- {
- /* When a temporary is in place for the class array, then the
- original class' declaration is stored in the saved
- descriptor. */
- if (DECL_LANG_SPECIFIC (decl) && GFC_DECL_SAVED_DESCRIPTOR (decl))
- decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
- else
- {
- /* Allow for dummy arguments and other good things. */
- if (POINTER_TYPE_P (TREE_TYPE (decl)))
- decl = build_fold_indirect_ref_loc (input_location, decl);
-
- /* Check if '_data' is an array descriptor. If it is not,
- the array must be one of the components of the class
- object, so return a null span. */
- if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (
- gfc_class_data_get (decl))))
- return NULL_TREE;
- }
- span = gfc_class_vtab_size_get (decl);
- /* For unlimited polymorphic entities then _len component needs
- to be multiplied with the size. */
- span = gfc_resize_class_size_with_len (NULL, decl, span);
- }
- else if (GFC_DECL_PTR_ARRAY_P (decl))
- {
- if (TREE_CODE (decl) == PARM_DECL)
- decl = build_fold_indirect_ref_loc (input_location, decl);
- span = gfc_conv_descriptor_span_get (decl);
- }
- else
- span = NULL_TREE;
- }
- else
- span = NULL_TREE;
-
- return span;
-}
-
-
tree
gfc_build_spanned_array_ref (tree base, tree offset, tree span)
{
@@ -487,11 +412,10 @@ gfc_build_spanned_array_ref (tree base, tree offset, tree span)
have to play it safe and use pointer arithmetic. */
tree
-gfc_build_array_ref (tree base, tree offset, tree decl,
- bool non_negative_offset, tree vptr)
+gfc_build_array_ref (tree base, tree offset, bool non_negative_offset,
+ tree spacing, tree align)
{
tree type = TREE_TYPE (base);
- tree span = NULL_TREE;
if (GFC_ARRAY_TYPE_P (type) && GFC_TYPE_ARRAY_RANK (type) == 0)
{
@@ -503,7 +427,6 @@ gfc_build_array_ref (tree base, tree offset, tree decl,
/* Scalar coarray, there is nothing to do. */
if (TREE_CODE (type) != ARRAY_TYPE)
{
- gcc_assert (decl == NULL_TREE);
gcc_assert (integer_zerop (offset));
return base;
}
@@ -516,28 +439,9 @@ gfc_build_array_ref (tree base, tree offset, tree decl,
/* Strip NON_LVALUE_EXPR nodes. */
STRIP_TYPE_NOPS (offset);
- /* If decl or vptr are non-null, pointer arithmetic for the array reference
- is likely. Generate the 'span' for the array reference. */
- if (vptr)
- {
- span = gfc_vptr_size_get (vptr);
-
- /* Check if this is an unlimited polymorphic object carrying a character
- payload. In this case, the 'len' field is non-zero. */
- if (decl && GFC_CLASS_TYPE_P (TREE_TYPE (decl)))
- span = gfc_resize_class_size_with_len (NULL, decl, span);
- }
- else if (decl)
- span = get_array_span (type, decl);
-
- /* If a non-null span has been generated reference the element with
- pointer arithmetic. */
- if (span != NULL_TREE)
- return gfc_build_spanned_array_ref (base, offset, span);
- /* Else use a straightforward array reference if possible. */
- else if (non_negative_offset)
+ if (non_negative_offset)
return build4_loc (input_location, ARRAY_REF, type, base, offset,
- NULL_TREE, NULL_TREE);
+ NULL_TREE, spacing);
/* Otherwise use pointer arithmetic. */
else
{
@@ -554,12 +458,13 @@ gfc_build_array_ref (tree base, tree offset, tree decl,
fold_convert (gfc_array_index_type, min))
: fold_convert (gfc_array_index_type, offset);
- tree elt_size = fold_convert (gfc_array_index_type,
- TYPE_SIZE_UNIT (type));
+ tree offset_align = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type,
+ zero_based_index, spacing);
tree offset_bytes = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type,
- zero_based_index, elt_size);
+ offset_align, align);
tree base_addr = gfc_build_addr_expr (pvoid_type_node, base);
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index ed083205ca02..7723f6fc350f 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -198,18 +198,29 @@ typedef struct gfc_array_info
tree data;
/* To move some of the array index calculation out of the innermost loop. */
tree offset;
+ /* Original offset. */
tree saved_offset;
- tree stride0;
+ tree align;
/* 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. In alignment-sized
+ units. */
+ 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;
@@ -636,9 +647,8 @@ tree gfc_get_extern_function_decl (gfc_symbol *,
tree gfc_build_addr_expr (tree, tree);
/* Build an ARRAY_REF. */
-tree gfc_build_array_ref (tree, tree, tree,
- bool non_negative_offset = false,
- tree vptr = NULL_TREE);
+tree gfc_build_array_ref (tree, tree, bool non_negative_offset = false,
+ tree spacing = NULL_TREE, tree align = NULL_TREE);
/* Build an array ref using pointer arithmetic. */
tree gfc_build_spanned_array_ref (tree base, tree offset, tree span);
@@ -1032,7 +1042,9 @@ 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 spacing[GFC_MAX_DIMENSIONS];
+ tree elem_len;
+ tree align;
tree size;
tree offset;
tree dtype;
@@ -1104,10 +1116,25 @@ 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_SPACING(node, dim) \
+ (TYPE_LANG_SPECIFIC(node)->spacing[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))
+#if 0
#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_SPACING((node), (dim)), \
+ GFC_TYPE_ARRAY_ALIGN((node))))
+#endif
+#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_ALIGN(node) (TYPE_LANG_SPECIFIC(node)->align)
#define GFC_TYPE_ARRAY_CAF_TOKEN(node) (TYPE_LANG_SPECIFIC(node)->caf_token)
#define GFC_TYPE_ARRAY_CAF_OFFSET(node) (TYPE_LANG_SPECIFIC(node)->caf_offset)
#define GFC_TYPE_ARRAY_SIZE(node) (TYPE_LANG_SPECIFIC(node)->size)
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index 97876fa9d8c2..0606f8ca2004 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -464,8 +464,9 @@ _gfortran_caf_failed_images (gfc_descriptor_t *array,
indicate an empty array. */
array->dim[0].lower_bound = 0;
array->dim[0]._ubound = -1;
- array->dim[0]._stride = 1;
+ array->dim[0].spacing = 1;
array->offset = 0;
+ array->align = local_kind;
}
@@ -486,8 +487,9 @@ _gfortran_caf_stopped_images (gfc_descriptor_t *array,
indicate an empty array. */
array->dim[0].lower_bound = 0;
array->dim[0]._ubound = -1;
- array->dim[0]._stride = 1;
+ array->dim[0].spacing = 1;
array->offset = 0;
+ array->align = local_kind;
}
diff --git a/libgfortran/intrinsics/associated.c b/libgfortran/intrinsics/associated.c
index 592c84c097af..e340d55f96ef 100644
--- a/libgfortran/intrinsics/associated.c
+++ b/libgfortran/intrinsics/associated.c
@@ -51,7 +51,7 @@ associated (const gfc_array_void *pointer, const gfc_array_void *target)
if (extent != GFC_DESCRIPTOR_EXTENT(target,n))
return 0;
- if (GFC_DESCRIPTOR_STRIDE(pointer,n) != GFC_DESCRIPTOR_STRIDE(target,n) && extent != 1)
+ if (GFC_DESCRIPTOR_SM(pointer,n) != GFC_DESCRIPTOR_SM(target,n) && extent != 1)
return 0;
if (extent <= 0)
return 0;
diff --git a/libgfortran/intrinsics/cshift0.c b/libgfortran/intrinsics/cshift0.c
index 70f82e0c2508..9d146390fbfa 100644
--- a/libgfortran/intrinsics/cshift0.c
+++ b/libgfortran/intrinsics/cshift0.c
@@ -62,19 +62,21 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array,
ret->offset = 0;
GFC_DTYPE_COPY(ret,array);
+ ret->align = array->align;
+
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
{
- index_type ub, str;
+ index_type ub, sp;
ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
if (i == 0)
- str = 1;
+ sp = GFC_DESCRIPTOR_SIZE(ret) / GFC_DESCRIPTOR_ALIGN(ret);
else
- str = GFC_DESCRIPTOR_EXTENT(ret,i-1) *
- GFC_DESCRIPTOR_STRIDE(ret,i-1);
+ sp = GFC_DESCRIPTOR_EXTENT(ret,i-1) *
+ GFC_DESCRIPTOR_SPACING(ret,i-1);
- GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
+ GFC_DIMENSION_SET(ret->dim[i], 0, ub, sp);
}
/* xmallocarray allocates a single byte for zero size. */
@@ -299,10 +301,10 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array,
{
if (dim == which)
{
- roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
+ roffset = GFC_DESCRIPTOR_SM(ret,dim);
if (roffset == 0)
roffset = size;
- soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
+ soffset = GFC_DESCRIPTOR_SM(array,dim);
if (soffset == 0)
soffset = size;
len = GFC_DESCRIPTOR_EXTENT(array,dim);
@@ -311,8 +313,8 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array,
{
count[n] = 0;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
- rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
- sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_SM(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_SM(array,dim);
n++;
}
}
diff --git a/libgfortran/intrinsics/eoshift0.c b/libgfortran/intrinsics/eoshift0.c
index ccdd7cd4bffb..7f11af25a1c8 100644
--- a/libgfortran/intrinsics/eoshift0.c
+++ b/libgfortran/intrinsics/eoshift0.c
@@ -67,19 +67,21 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
ret->offset = 0;
GFC_DTYPE_COPY(ret,array);
+ ret->align = array->align;
+
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
{
- index_type ub, str;
+ index_type ub, sp;
ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
if (i == 0)
- str = 1;
+ sp = GFC_DESCRIPTOR_SIZE(ret) / GFC_DESCRIPTOR_ALIGN(ret);
else
- str = GFC_DESCRIPTOR_EXTENT(ret,i-1)
- * GFC_DESCRIPTOR_STRIDE(ret,i-1);
+ sp = GFC_DESCRIPTOR_EXTENT(ret,i-1)
+ * GFC_DESCRIPTOR_SPACING(ret,i-1);
- GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
+ GFC_DIMENSION_SET(ret->dim[i], 0, ub, sp);
}
@@ -106,20 +108,20 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
{
/* Test if both ret and array are contiguous. */
index_type r_ex, a_ex;
- r_ex = 1;
- a_ex = 1;
+ r_ex = GFC_DESCRIPTOR_SIZE (ret);
+ a_ex = GFC_DESCRIPTOR_SIZE (array);
do_blocked = true;
dim = GFC_DESCRIPTOR_RANK (array);
for (n = 0; n < dim; n ++)
{
index_type rs, as;
- rs = GFC_DESCRIPTOR_STRIDE (ret, n);
+ rs = GFC_DESCRIPTOR_SM (ret, n);
if (rs != r_ex)
{
do_blocked = false;
break;
}
- as = GFC_DESCRIPTOR_STRIDE (array, n);
+ as = GFC_DESCRIPTOR_SM (array, n);
if (as != a_ex)
{
do_blocked = false;
@@ -156,8 +158,8 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
{
count[n] = 0;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
- rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
- sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_SM(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_SM(array,dim);
n++;
}
count[n] = 0;
@@ -169,10 +171,10 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
{
if (dim == which)
{
- roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
+ roffset = GFC_DESCRIPTOR_SM(ret,dim);
if (roffset == 0)
roffset = size;
- soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
+ soffset = GFC_DESCRIPTOR_SM(array,dim);
if (soffset == 0)
soffset = size;
len = GFC_DESCRIPTOR_EXTENT(array,dim);
@@ -181,8 +183,8 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
{
count[n] = 0;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
- rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
- sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_SM(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_SM(array,dim);
n++;
}
}
diff --git a/libgfortran/intrinsics/eoshift2.c b/libgfortran/intrinsics/eoshift2.c
index d3fa4b1d84cd..4a9e763d07b6 100644
--- a/libgfortran/intrinsics/eoshift2.c
+++ b/libgfortran/intrinsics/eoshift2.c
@@ -73,23 +73,24 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array,
ret->offset = 0;
GFC_DTYPE_COPY(ret,array);
+ ret->align = array->align;
/* xmallocarray allocates a single byte for zero size. */
ret->base_addr = xmallocarray (arraysize, size);
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
{
- index_type ub, str;
+ index_type ub, sp;
ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
if (i == 0)
- str = 1;
+ sp = GFC_DESCRIPTOR_SIZE(ret) / ret->align;
else
- str = GFC_DESCRIPTOR_EXTENT(ret,i-1)
- * GFC_DESCRIPTOR_STRIDE(ret,i-1);
+ sp = GFC_DESCRIPTOR_EXTENT(ret,i-1)
+ * GFC_DESCRIPTOR_SPACING(ret,i-1);
- GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
+ GFC_DIMENSION_SET(ret->dim[i], 0, ub, sp);
}
}
else if (unlikely (compile_options.bounds_check))
diff --git a/libgfortran/intrinsics/move_alloc.c b/libgfortran/intrinsics/move_alloc.c
index 194d598e7d09..ad9062a15656 100644
--- a/libgfortran/intrinsics/move_alloc.c
+++ b/libgfortran/intrinsics/move_alloc.c
@@ -40,12 +40,13 @@ move_alloc (gfc_array_char * from, gfc_array_char * to)
{
GFC_DIMENSION_SET(to->dim[i],GFC_DESCRIPTOR_LBOUND(from,i),
GFC_DESCRIPTOR_UBOUND(from,i),
- GFC_DESCRIPTOR_STRIDE(from,i));
+ GFC_DESCRIPTOR_SPACING(from,i));
GFC_DIMENSION_SET(from->dim[i],GFC_DESCRIPTOR_LBOUND(from,i),
GFC_DESCRIPTOR_LBOUND(from,i), 0);
}
to->offset = from->offset;
+ to->align = from->align;
GFC_DTYPE_COPY(to,from);
to->base_addr = from->base_addr;
from->base_addr = NULL;
diff --git a/libgfortran/intrinsics/pack_generic.c b/libgfortran/intrinsics/pack_generic.c
index 3de2a9f453b2..3d6e5623342d 100644
--- a/libgfortran/intrinsics/pack_generic.c
+++ b/libgfortran/intrinsics/pack_generic.c
@@ -162,6 +162,7 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array,
GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1);
ret->offset = 0;
+ ret->align = array->align;
/* xmallocarray allocates a single byte for zero size. */
ret->base_addr = xmallocarray (total, size);
@@ -538,6 +539,7 @@ pack_s_internal (gfc_array_char *ret, const gfc_array_char *array,
GFC_DIMENSION_SET(ret->dim[0],0,total-1,1);
ret->offset = 0;
+ ret->align = array->align;
ret->base_addr = xmallocarray (total, size);
diff --git a/libgfortran/intrinsics/reshape_generic.c b/libgfortran/intrinsics/reshape_generic.c
index f65b804f42c2..fe3b6bc7bcdd 100644
--- a/libgfortran/intrinsics/reshape_generic.c
+++ b/libgfortran/intrinsics/reshape_generic.c
@@ -41,6 +41,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape,
index_type rdim;
index_type rsize;
index_type rs;
+ index_type spacing;
index_type rex;
char * restrict rptr;
/* s.* indicates the source array. */
@@ -90,13 +91,16 @@ reshape_internal (parray *ret, parray *source, shape_type *shape,
index_type alloc_size;
rs = 1;
+ spacing = GFC_DESCRIPTOR_SIZE(source) / GFC_DESCRIPTOR_ALIGN(source);
+
for (n = 0; n < rdim; n++)
{
rex = shape_data[n];
- GFC_DIMENSION_SET(ret->dim[n],0,rex - 1,rs);
+ GFC_DIMENSION_SET(ret->dim[n],0,rex - 1,spacing);
rs *= rex;
+ spacing *= rex;
}
ret->offset = 0;
diff --git a/libgfortran/intrinsics/spread_generic.c b/libgfortran/intrinsics/spread_generic.c
index 3fe1b503a707..fb4fd7093516 100644
--- a/libgfortran/intrinsics/spread_generic.c
+++ b/libgfortran/intrinsics/spread_generic.c
@@ -72,11 +72,13 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source,
return array descriptor. */
size_t ub, stride;
+ index_type spacing;
ret->dtype.rank = rrank;
dim = 0;
rs = 1;
+ spacing = size / source->align;
for (n = 0; n < rrank; n++)
{
stride = rs;
@@ -85,6 +87,7 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source,
ub = ncopies - 1;
rdelta = rs * size;
rs *= ncopies;
+ spacing *= ncopies;
}
else
{
@@ -95,12 +98,14 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source,
ub = extent[dim]-1;
rs *= extent[dim];
+ spacing *= extent[dim];
dim++;
}
- GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride);
+ GFC_DIMENSION_SET(ret->dim[n], 0, ub, spacing);
}
ret->offset = 0;
+ ret->align = source->align;
ret->base_addr = xmallocarray (rs, size);
if (rs <= 0)
@@ -125,7 +130,7 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source,
ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (n == *along - 1)
{
- rdelta = GFC_DESCRIPTOR_STRIDE_BYTES(ret,n);
+ rdelta = GFC_DESCRIPTOR_SM(ret,n);
if (ret_extent != ncopies)
runtime_error("Incorrect extent in return value of SPREAD"
@@ -146,8 +151,8 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source,
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(source,dim);
- rstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,n);
+ sstride[dim] = GFC_DESCRIPTOR_SM(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_SM(ret,n);
dim++;
}
}
@@ -158,7 +163,7 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source,
{
if (n == *along - 1)
{
- rdelta = GFC_DESCRIPTOR_STRIDE_BYTES(ret,n);
+ rdelta = GFC_DESCRIPTOR_SM(ret,n);
}
else
{
@@ -166,8 +171,8 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source,
extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(source,dim);
- rstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,n);
+ sstride[dim] = GFC_DESCRIPTOR_SM(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_SM(ret,n);
dim++;
}
}
@@ -248,7 +253,9 @@ spread_internal_scalar (gfc_array_char *ret, const char *source,
{
ret->base_addr = xmallocarray (ncopies, size);
ret->offset = 0;
- GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1);
+ ret->align = source->align;
+ GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1,
+ size / source->align);
}
else
{
diff --git a/libgfortran/intrinsics/unpack_generic.c b/libgfortran/intrinsics/unpack_generic.c
index ffbad1abf5aa..81692cab09e2 100644
--- a/libgfortran/intrinsics/unpack_generic.c
+++ b/libgfortran/intrinsics/unpack_generic.c
@@ -62,6 +62,7 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector,
index_type rstride[GFC_MAX_DIMENSIONS];
index_type rstride0;
index_type rs;
+ index_type spacing;
char * restrict rptr;
/* v.* indicates the vector array. */
index_type vstride0;
@@ -111,17 +112,19 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector,
return array descriptor. */
dim = GFC_DESCRIPTOR_RANK (mask);
rs = 1;
+ spacing = size / vector->align;
for (n = 0; n < dim; n++)
{
count[n] = 0;
GFC_DIMENSION_SET(ret->dim[n], 0,
- GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, spacing);
extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret, n);
- fstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(field, n);
- mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n);
+ rstride[n] = GFC_DESCRIPTOR_SM(ret, n);
+ fstride[n] = GFC_DESCRIPTOR_SM(field, n);
+ mstride[n] = GFC_DESCRIPTOR_SM(mask, n);
rs *= extent[n];
+ spacing *= extent[n];
}
ret->offset = 0;
ret->base_addr = xmallocarray (rs, size);
@@ -134,9 +137,9 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector,
count[n] = 0;
extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret, n);
- fstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(field, n);
- mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n);
+ rstride[n] = GFC_DESCRIPTOR_SM(ret, n);
+ fstride[n] = GFC_DESCRIPTOR_SM(field, n);
+ mstride[n] = GFC_DESCRIPTOR_SM(mask, n);
}
}
@@ -146,7 +149,7 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector,
/* This assert makes sure GCC knows we can access *stride[0] later. */
assert (dim > 0);
- vstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(vector,0);
+ vstride0 = GFC_DESCRIPTOR_SM(vector,0);
rstride0 = rstride[0];
fstride0 = fstride[0];
mstride0 = mstride[0];
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 3fc53938b4a2..d36900c08d4d 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 spacing, 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,spacing);
}
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 25c3cb6641c3..daa11b9ebc74 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -367,7 +367,7 @@ typedef GFC_UINTEGER_4 gfc_char4_t;
typedef struct descriptor_dimension
{
- index_type _stride;
+ index_type spacing;
index_type lower_bound;
index_type _ubound;
}
@@ -389,6 +389,7 @@ struct {\
size_t offset;\
dtype_type dtype;\
index_type span;\
+ index_type align; \
descriptor_dimension dim[];\
}
@@ -463,30 +464,24 @@ typedef GFC_FULL_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_4) gfc_full_a
#define GFC_DESCRIPTOR_DATA(desc) ((desc)->base_addr)
#define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->dtype)
#define GFC_DESCRIPTOR_SPAN(desc) ((desc)->span)
+#define GFC_DESCRIPTOR_ALIGN(desc) ((desc)->align)
-#define GFC_DIMENSION_LBOUND(dim) ((dim).lower_bound)
-#define GFC_DIMENSION_UBOUND(dim) ((dim)._ubound)
-#define GFC_DIMENSION_STRIDE(dim) ((dim)._stride)
-#define GFC_DIMENSION_EXTENT(dim) ((dim)._ubound + 1 - (dim).lower_bound)
-#define GFC_DIMENSION_SET(dim,lb,ub,str) \
+#define GFC_DIMENSION_SET(dim,lb,ub,sp) \
do \
{ \
(dim).lower_bound = lb; \
(dim)._ubound = ub; \
- (dim)._stride = str; \
+ (dim).spacing = sp; \
} while (0)
#define GFC_DESCRIPTOR_LBOUND(desc,i) ((desc)->dim[i].lower_bound)
#define GFC_DESCRIPTOR_UBOUND(desc,i) ((desc)->dim[i]._ubound)
-#define GFC_DESCRIPTOR_EXTENT(desc,i) ((desc)->dim[i]._ubound + 1 \
- - (desc)->dim[i].lower_bound)
-#define GFC_DESCRIPTOR_EXTENT_BYTES(desc,i) \
- (GFC_DESCRIPTOR_EXTENT(desc,i) * GFC_DESCRIPTOR_SIZE(desc))
-
-#define GFC_DESCRIPTOR_STRIDE(desc,i) ((desc)->dim[i]._stride)
-#define GFC_DESCRIPTOR_STRIDE_BYTES(desc,i) \
- (GFC_DESCRIPTOR_STRIDE(desc,i) * GFC_DESCRIPTOR_SIZE(desc))
+#define GFC_DESCRIPTOR_SPACING(desc,i) ((desc)->dim[i].spacing)
+#define GFC_DESCRIPTOR_SM(desc,i) (GFC_DESCRIPTOR_SPACING(desc,i) * GFC_DESCRIPTOR_ALIGN(desc))
+#define GFC_DESCRIPTOR_EXTENT(desc,i) (GFC_DESCRIPTOR_UBOUND(desc,i) + (GFC_DESCRIPTOR_LBOUND(desc,i) - 1))
+
+#define GFC_DESCRIPTOR_STRIDE(desc,i) (GFC_DESCRIPTOR_SM(desc,i) / GFC_DESCRIPTOR_SIZE(desc))
/* Macros to get both the size and the type with a single masking operation */
diff --git a/libgfortran/m4/reshape.m4 b/libgfortran/m4/reshape.m4
index 705a102c357d..dec5ed254483 100644
--- a/libgfortran/m4/reshape.m4
+++ b/libgfortran/m4/reshape.m4
@@ -57,6 +57,7 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret,
index_type rdim;
index_type rsize;
index_type rs;
+ index_type spacing;
index_type rex;
'rtype_name` *rptr;
/* s.* indicates the source array. */
@@ -104,15 +105,18 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret,
index_type alloc_size;
rs = 1;
+ spacing = GFC_DESCRIPTOR_SIZE(source) / source->align;
for (index_type n = 0; n < rdim; n++)
{
rex = shape_data[n];
- GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, spacing);
rs *= rex;
+ spacing *= rex;
}
ret->offset = 0;
+ ret->align = source->align;
if (unlikely (rs < 1))
alloc_size = 0;
More information about the Gcc-cvs
mailing list