Make ALLOCATE honour an alignment request by calling aligned_alloc
instead of malloc, rounding the size up to a multiple of the alignment
as C11 requires. The request may come from !GCC$ ATTRIBUTES ALIGN(n)
on the allocate-object or from the new per-statement directive
!GCC$ ALLOCATE (var-list) ALIGN(n)
which follows the !GCC$ UNROLL pattern and applies to the immediately
following ALLOCATE statement only. Where both apply to the same
object, the larger alignment wins.
gcc/fortran/ChangeLog:
* gfortran.h (struct gfc_alloc): Add align field.
(struct gfc_gcc_alloc_align): New.
(directive_allocate_align): Declare.
(gfc_free_gcc_alloc_align): Declare.
* decl.cc (directive_allocate_align): Define.
(gfc_free_gcc_alloc_align): New function.
(gfc_match_gcc_allocate): New function.
* match.h (gfc_match_gcc_allocate): Declare.
* parse.cc (decode_gcc_attribute): Recognise the ALLOCATE
directive.
(parse_executable): Diagnose a directive that is not followed by
an ALLOCATE statement.
* match.cc (gfc_match_allocate): Apply a pending directive to the
matching allocate-objects.
* f95-lang.cc (gfc_init_builtin_functions): Declare aligned_alloc.
* trans.h (gfc_allocate_using_malloc): Add alignment argument.
(gfc_allocate_allocatable): Likewise.
* trans.cc (gfc_allocate_using_malloc): Use aligned_alloc when an
alignment is requested.
(gfc_allocate_allocatable): Pass the alignment through.
* trans-array.h (gfc_array_allocate): Add alignment argument.
* trans-array.cc (gfc_array_allocate): Pass the alignment through.
* trans-stmt.cc (gfc_trans_allocate): Compute the requested
alignment per allocate-object.
gcc/testsuite/ChangeLog:
* gfortran.dg/align_3.f90: New test.
* gfortran.dg/align_4.f90: New test.
---
gcc/fortran/decl.cc | 90 +++++++++++++++++++++++++++
gcc/fortran/f95-lang.cc | 5 ++
gcc/fortran/gfortran.h | 13 ++++
gcc/fortran/match.cc | 22 +++++++
gcc/fortran/match.h | 1 +
gcc/fortran/parse.cc | 8 +++
gcc/fortran/trans-array.cc | 9 ++-
gcc/fortran/trans-array.h | 3 +-
gcc/fortran/trans-stmt.cc | 31 ++++++++-
gcc/fortran/trans.cc | 32 ++++++++--
gcc/fortran/trans.h | 4 +-
gcc/testsuite/gfortran.dg/align_3.f90 | 41 ++++++++++++
gcc/testsuite/gfortran.dg/align_4.f90 | 23 +++++++
13 files changed, 268 insertions(+), 14 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/align_3.f90
create mode 100644 gcc/testsuite/gfortran.dg/align_4.f90
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index c6472cc14..efe6c2837 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -13023,6 +13023,96 @@ gfc_match_gcc_unroll (void)
return MATCH_ERROR;
}
+gfc_gcc_alloc_align *directive_allocate_align = NULL;
+
+void
+gfc_free_gcc_alloc_align (void)
+{
+ gfc_gcc_alloc_align *p, *q;
+ for (p = directive_allocate_align; p; p = q)
+ {
+ q = p->next;
+ free (p);
+ }
+ directive_allocate_align = NULL;
+}
+
+/* Match a !GCC$ ALLOCATE statement of the form:
+ !GCC$ ALLOCATE (var [, var]...) ALIGN(n)
+
+ The named objects are aligned to n bytes by the ALLOCATE that follows.
+ n must be a positive power of two. */
+match
+gfc_match_gcc_allocate (void)
+{
+ char name[GFC_MAX_SYMBOL_LEN + 1];
+ gfc_gcc_alloc_align *head = NULL, *tail = NULL;
+ int align;
+
+ /* Drop a previous directive that was never consumed. */
+ gfc_free_gcc_alloc_align ();
+
+ if (gfc_match_char ('(') != MATCH_YES)
+ goto syntax;
+
+ for (;;)
+ {
+ if (gfc_match_name (name) != MATCH_YES)
+ goto syntax;
+
+ gfc_gcc_alloc_align *n = XCNEW (gfc_gcc_alloc_align);
+ strcpy (n->name, name);
+ if (head == NULL)
+ head = tail = n;
+ else
+ {
+ tail->next = n;
+ tail = n;
+ }
+
+ if (gfc_match_char (',') == MATCH_YES)
+ continue;
+ if (gfc_match_char (')') == MATCH_YES)
+ break;
+ goto syntax;
+ }
+
+ if (gfc_match (" align (") != MATCH_YES)
+ goto syntax;
+ if (gfc_match_small_int (&align) != MATCH_YES)
+ goto syntax;
+ if (gfc_match_char (')') != MATCH_YES)
+ goto syntax;
+ if (gfc_match_eos () != MATCH_YES)
+ goto syntax;
+
+ if (align < 1 || (align & (align - 1)) != 0)
+ {
+ gfc_error ("ALIGN value (%d) in !GCC$ ALLOCATE directive at %C must be "
+ "a positive power of two", align);
+ goto cleanup;
+ }
+
+ for (tail = head; tail; tail = tail->next)
+ tail->align = (unsigned) align;
+
+ directive_allocate_align = head;
+ return MATCH_YES;
+
+syntax:
+ gfc_error ("Syntax error in !GCC$ ALLOCATE directive at %C");
+cleanup:
+ {
+ gfc_gcc_alloc_align *p, *q;
+ for (p = head; p; p = q)
+ {
+ q = p->next;
+ free (p);
+ }
+ }
+ return MATCH_ERROR;
+}
+
/* Match a !GCC$ builtin (b) attributes simd flags if('target') form:
The parameter b is name of a middle-end built-in.
diff --git a/gcc/fortran/f95-lang.cc b/gcc/fortran/f95-lang.cc
index 45aab3486..1335278b9 100644
--- a/gcc/fortran/f95-lang.cc
+++ b/gcc/fortran/f95-lang.cc
@@ -1031,6 +1031,11 @@ gfc_init_builtin_functions (void)
"calloc", ATTR_NOTHROW_LEAF_MALLOC_LIST);
DECL_IS_MALLOC (builtin_decl_explicit (BUILT_IN_CALLOC)) = 1;
+ gfc_define_builtin ("__builtin_aligned_alloc", ftype,
+ BUILT_IN_ALIGNED_ALLOC,
+ "aligned_alloc", ATTR_NOTHROW_LEAF_MALLOC_LIST);
+ DECL_IS_MALLOC (builtin_decl_explicit (BUILT_IN_ALIGNED_ALLOC)) = 1;
+
ftype = build_function_type_list (pvoid_type_node, pvoid_type_node,
size_type_node, NULL_TREE);
gfc_define_builtin ("__builtin_realloc", ftype, BUILT_IN_REALLOC,
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 561d73e04..10f407846 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3045,6 +3045,8 @@ gfc_iterator;
typedef struct gfc_alloc
{
gfc_expr *expr;
+ /* From !GCC$ ALLOCATE ALIGN(n), in bytes; 0 if none. */
+ unsigned align;
struct gfc_alloc *next;
}
gfc_alloc;
@@ -3466,6 +3468,17 @@ extern bool directive_ivdep;
extern bool directive_vector;
extern bool directive_novector;
+/* Set by !GCC$ ALLOCATE ALIGN(n), used by the next ALLOCATE. */
+typedef struct gfc_gcc_alloc_align
+{
+ char name[GFC_MAX_SYMBOL_LEN + 1];
+ unsigned align;
+ struct gfc_gcc_alloc_align *next;
+}
+gfc_gcc_alloc_align;
+extern gfc_gcc_alloc_align *directive_allocate_align;
+void gfc_free_gcc_alloc_align (void);
+
/* SIMD clause enum. */
enum gfc_simd_clause
{
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 62bdb8687..8b1d9c86c 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -5416,6 +5416,28 @@ alloc_opt_list:
new_st.ext.alloc.list = head;
new_st.ext.alloc.ts = ts;
+ /* Apply a preceding !GCC$ ALLOCATE ALIGN directive. */
+ if (directive_allocate_align)
+ {
+ gfc_gcc_alloc_align *d;
+ for (d = directive_allocate_align; d; d = d->next)
+ {
+ gfc_alloc *a;
+ bool found = false;
+ for (a = head; a; a = a->next)
+ if (a->expr->symtree
+ && strcmp (a->expr->symtree->n.sym->name, d->name) == 0)
+ {
+ a->align = d->align;
+ found = true;
+ }
+ if (!found)
+ gfc_warning (0, "Object %qs in !GCC$ ALLOCATE ALIGN directive does "
+ "not appear in the ALLOCATE statement at %C", d->name);
+ }
+ gfc_free_gcc_alloc_align ();
+ }
+
if (type_param_spec_list)
gfc_free_actual_arglist (type_param_spec_list);
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 52cb2f0cd..0b4d2632d 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -278,6 +278,7 @@ match gfc_match_contiguous (void);
match gfc_match_dimension (void);
match gfc_match_external (void);
match gfc_match_gcc_attributes (void);
+match gfc_match_gcc_allocate (void);
match gfc_match_gcc_builtin (void);
match gfc_match_gcc_ivdep (void);
match gfc_match_gcc_novector (void);
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index a41bf090c..fca0e850a 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -1483,6 +1483,7 @@ decode_gcc_attribute (void)
old_locus = gfc_current_locus;
match ("attributes", gfc_match_gcc_attributes, ST_ATTR_DECL);
+ match ("allocate", gfc_match_gcc_allocate, ST_NONE);
match ("unroll", gfc_match_gcc_unroll, ST_NONE);
match ("builtin", gfc_match_gcc_builtin, ST_NONE);
match ("ivdep", gfc_match_gcc_ivdep, ST_NONE);
@@ -6848,6 +6849,13 @@ parse_executable (gfc_statement st)
gfc_error ("%<GCC novector%> "
"directive not at the start of a loop at %C");
+ if (directive_allocate_align)
+ {
+ gfc_error ("%<GCC allocate%> directive not immediately before an "
+ "ALLOCATE statement at %C");
+ gfc_free_gcc_alloc_align ();
+ }
+
st = next_statement ();
}
}
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index b57c18aba..64fd44950 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -6781,7 +6781,8 @@ bool
gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
tree errlen, tree label_finish, tree expr3_elem_size,
gfc_expr *expr3, tree e3_arr_desc, bool e3_has_nodescriptor,
- gfc_omp_namelist *omp_alloc, bool explicit_ts)
+ gfc_omp_namelist *omp_alloc, bool explicit_ts,
+ unsigned user_align)
{
tree tmp;
tree pointer;
@@ -7026,7 +7027,8 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree
status, tree errmsg,
gfc_allocate_allocatable (&elseblock, pointer, size, token,
status, errmsg, errlen, label_finish, expr,
coref != NULL ? coref->u.ar.as->corank : 0,
- omp_cond, omp_alt_alloc, succ_add_expr);
+ omp_cond, omp_alt_alloc, succ_add_expr,
+ user_align);
else if (non_ulimate_coarray_ptr_comp && token)
/* The token is set only for GFC_FCOARRAY_LIB mode. */
gfc_allocate_using_caf_lib (&elseblock, pointer, size, token, status,
@@ -7034,7 +7036,8 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree
status, tree errmsg,
GFC_CAF_COARRAY_ALLOC_ALLOCATE_ONLY);
else
gfc_allocate_using_malloc (&elseblock, pointer, size, status,
- omp_cond, omp_alt_alloc, succ_add_expr);
+ omp_cond, omp_alt_alloc, succ_add_expr,
+ user_align);
if (dimension)
{
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 4b51e5469..eaa83fac4 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -21,7 +21,8 @@ along with GCC; see the file COPYING3. If not see
/* Generate code to initialize and allocate an array. Statements are added to
se, which should contain an expression for the array descriptor. */
bool gfc_array_allocate (gfc_se *, gfc_expr *, tree, tree, tree, tree, tree,
- gfc_expr *, tree, bool, gfc_omp_namelist *, bool);
+ gfc_expr *, tree, bool, gfc_omp_namelist *, bool,
+ unsigned = 0);
/* Allow the bounds of a loop to be set from a callee's array spec. */
void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping *,
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 49f8cd8d7..b2d0ddeb5 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -6703,6 +6703,9 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist
*omp_allocate)
if (!code->ext.alloc.list)
return NULL_TREE;
+ /* Requested alignment of the current object, in bytes; 0 if none. */
+ unsigned user_align = 0;
+
stat = tmp = memsz = al_vptr = al_len = NULL_TREE;
expr3 = expr3_vptr = expr3_len = expr3_esize = NULL_TREE;
label_errmsg = label_finish = errmsg = errlen = NULL_TREE;
@@ -7171,6 +7174,25 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist
*omp_allocate)
for (al = code->ext.alloc.list; al != NULL; al = al->next)
{
expr = gfc_copy_expr (al->expr);
+
+ /* Take the larger of the ALLOCATE directive and the symbol's
+ attribute. The attribute does not apply to component refs. */
+ user_align = al->align;
+ if (expr->symtree
+ && (expr->symtree->n.sym->attr.ext_attr & (1 << EXT_ATTR_ALIGN)))
+ {
+ bool comp_ref = false;
+ for (gfc_ref *r = expr->ref; r; r = r->next)
+ if (r->type == REF_COMPONENT)
+ {
+ comp_ref = true;
+ break;
+ }
+ if (!comp_ref)
+ user_align = MAX (user_align,
+ expr->symtree->n.sym->attr.ext_align);
+ }
+
/* UNLIMITED_POLY () needs the _data component to be set, when
expr is a unlimited polymorphic object. But the _data component
has not been set yet, so check the derived type's attr for the
@@ -7304,7 +7326,8 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist
*omp_allocate)
tmp, e3rhs ? e3rhs : code->expr3,
e3_is == E3_DESC ? expr3 : NULL_TREE,
e3_has_nodescriptor, omp_alloc_item,
- code->ext.alloc.ts.type != BT_UNKNOWN))
+ code->ext.alloc.ts.type != BT_UNKNOWN,
+ user_align))
{
/* A scalar or derived type. First compute the size to
allocate.
@@ -7476,10 +7499,12 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist
*omp_allocate)
gfc_allocate_allocatable (&se.pre, se.expr, memsz,
NULL_TREE, stat, errmsg, errlen,
label_finish, expr, 0,
- omp_cond, omp_alt_alloc, succ_add_expr);
+ omp_cond, omp_alt_alloc, succ_add_expr,
+ user_align);
else
gfc_allocate_using_malloc (&se.pre, se.expr, memsz, stat,
- omp_cond, omp_alt_alloc, succ_add_expr);
+ omp_cond, omp_alt_alloc, succ_add_expr,
+ user_align);
}
else
{
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 1d7006a69..21c3d4ea9 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -819,7 +819,7 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size)
void
gfc_allocate_using_malloc (stmtblock_t * block, tree pointer,
tree size, tree status, tree cond, tree alt_alloc,
- tree extra_success_expr)
+ tree extra_success_expr, unsigned align)
{
tree tmp, error_cond;
stmtblock_t on_error;
@@ -838,8 +838,29 @@ gfc_allocate_using_malloc (stmtblock_t * block, tree
pointer,
size, build_int_cst (size_type_node, 1));
if (!cond_is_true)
- tmp = build_call_expr_loc (input_location,
- builtin_decl_explicit (BUILT_IN_MALLOC), 1, tmp);
+ {
+ if (align > 0)
+ {
+ /* aligned_alloc wants the size to be a multiple of the
+ alignment, so round it up. */
+ tree mask = build_int_cst (size_type_node, align - 1);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR, size_type_node,
+ tmp, mask);
+ tmp = fold_build2_loc (input_location, BIT_AND_EXPR,
+ size_type_node, tmp,
+ fold_build1_loc (input_location, BIT_NOT_EXPR,
+ size_type_node, mask));
+ tmp = build_call_expr_loc (input_location,
+ builtin_decl_explicit
+ (BUILT_IN_ALIGNED_ALLOC), 2,
+ build_int_cst (size_type_node, align),
+ tmp);
+ }
+ else
+ tmp = build_call_expr_loc (input_location,
+ builtin_decl_explicit (BUILT_IN_MALLOC),
+ 1, tmp);
+ }
else
tmp = alt_alloc;
@@ -960,7 +981,8 @@ void
gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size,
tree token, tree status, tree errmsg, tree errlen,
tree label_finish, gfc_expr* expr, int corank,
- tree cond, tree alt_alloc, tree extra_success_expr)
+ tree cond, tree alt_alloc, tree extra_success_expr,
+ unsigned align)
{
stmtblock_t alloc_block;
tree tmp, null_mem, alloc, error;
@@ -1059,7 +1081,7 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem,
tree size,
}
else
gfc_allocate_using_malloc (&alloc_block, mem, size, status,
- cond, alt_alloc, extra_success_expr);
+ cond, alt_alloc, extra_success_expr, align);
alloc = gfc_finish_block (&alloc_block);
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index f97fefd2a..c310a650d 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -764,12 +764,12 @@ void gfc_allocate_using_caf_lib (stmtblock_t *, tree,
tree, tree, tree, tree,
void gfc_allocate_allocatable (stmtblock_t*, tree, tree, tree, tree,
tree, tree, tree, gfc_expr*, int,
tree = NULL_TREE, tree = NULL_TREE,
- tree = NULL_TREE);
+ tree = NULL_TREE, unsigned = 0);
/* Allocate memory, with optional status variable. */
void gfc_allocate_using_malloc (stmtblock_t *, tree, tree, tree,
tree = NULL_TREE, tree = NULL_TREE,
- tree = NULL_TREE);
+ tree = NULL_TREE, unsigned = 0);
/* Generate code to deallocate an array. */
tree gfc_deallocate_with_status (tree, tree, tree, tree, tree, bool, gfc_expr
*,
diff --git a/gcc/testsuite/gfortran.dg/align_3.f90
b/gcc/testsuite/gfortran.dg/align_3.f90
new file mode 100644
index 000000000..f82682388
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/align_3.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+!
+! ALLOCATE honours ALIGN from both the attribute and the directive.
+! Repeated because plain malloc may return an aligned block by chance.
+
+program align_3
+ implicit none
+
+ real(kind=4), allocatable :: attr_arr(:)
+ !GCC$ ATTRIBUTES ALIGN(64) :: attr_arr
+
+ real(kind=4), allocatable :: attr_scalar
+ !GCC$ ATTRIBUTES ALIGN(64) :: attr_scalar
+
+ ! Aligned by the directive only.
+ real(kind=4), allocatable :: dir_arr(:)
+
+ ! Attribute says 32, directive below says 128; 128 must win.
+ real(kind=4), allocatable :: both(:)
+ !GCC$ ATTRIBUTES ALIGN(32) :: both
+
+ integer :: i
+
+ do i = 1, 8
+ allocate (attr_arr(13))
+ if (iand (loc (attr_arr), 63_8) /= 0) stop 1
+
+ allocate (attr_scalar)
+ if (iand (loc (attr_scalar), 63_8) /= 0) stop 2
+
+ !GCC$ ALLOCATE (dir_arr) ALIGN(128)
+ allocate (dir_arr(7))
+ if (iand (loc (dir_arr), 127_8) /= 0) stop 3
+
+ !GCC$ ALLOCATE (both) ALIGN(128)
+ allocate (both(9))
+ if (iand (loc (both), 127_8) /= 0) stop 4
+
+ deallocate (attr_arr, attr_scalar, dir_arr, both)
+ end do
+end program align_3
diff --git a/gcc/testsuite/gfortran.dg/align_4.f90
b/gcc/testsuite/gfortran.dg/align_4.f90
new file mode 100644
index 000000000..ead366536
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/align_4.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+!
+! Invalid uses of the !GCC$ ALLOCATE (...) ALIGN(n) directive.
+
+subroutine bad_value
+ real, allocatable :: a(:)
+ !GCC$ ALLOCATE (a) ALIGN(24) ! { dg-error "must be a positive power of two" }
+ allocate (a(4))
+end subroutine bad_value
+
+subroutine bad_syntax
+ real, allocatable :: b(:)
+ !GCC$ ALLOCATE (b) ! { dg-error "Syntax error in !GCC\\\$ ALLOCATE
directive" }
+ allocate (b(4))
+end subroutine bad_syntax
+
+subroutine not_before_allocate
+ real, allocatable :: c(:)
+ integer :: i
+ !GCC$ ALLOCATE (c) ALIGN(64)
+ i = 1 ! { dg-error "not immediately before an ALLOCATE statement" }
+ allocate (c(4))
+end subroutine not_before_allocate
--
2.50.1 (Apple Git-155)
