+2011-07-06 Daniel Carrera <dcarrera@gmail.com>
+
+ * trans-array.c (gfc_array_allocate): Rename allocatable_array to
+ allocatable. Rename function gfc_allocate_array_with_status to
+ gfc_allocate_allocatable_with_status. Update function call for
+ gfc_allocate_with_status.
+ * trans-opemp.c (gfc_omp_clause_default_ctor): Rename function
+ gfc_allocate_array_with_status to gfc_allocate_allocatable_with_status.
+ * trans-stmt.c (gfc_trans_allocate): Update function call for
+ gfc_allocate_with_status. Rename function gfc_allocate_array_with_status
+ to gfc_allocate_allocatable_with_status.
+ * trans.c (gfc_call_malloc): Add new parameter gfc_allocate_with_status
+ so it uses the library for memory allocation when -fcoarray=lib.
+ (gfc_allocate_allocatable_with_status): Renamed from
+ gfc_allocate_array_with_status.
+ (gfc_allocate_allocatable_with_status): Update function call for
+ gfc_allocate_with_status.
+ * trans.h (gfc_coarray_type): New enum.
+ (gfc_allocate_with_status): Update prototype.
+ (gfc_allocate_allocatable_with_status): Renamed from
+ gfc_allocate_array_with_status.
+ * trans-decl.c (generate_coarray_sym_init): Use the new constant
+ GFC_CAF_COARRAY_ALLOC in the call to gfor_fndecl_caf_register.
+
2011-07-06 Richard Guenther <rguenther@suse.de>
* f95-lang.c (gfc_init_decl_processing):
gfc_expr **lower;
gfc_expr **upper;
gfc_ref *ref, *prev_ref = NULL;
- bool allocatable_array, coarray;
+ bool allocatable, coarray;
ref = expr->ref;
if (!prev_ref)
{
- allocatable_array = expr->symtree->n.sym->attr.allocatable;
+ allocatable = expr->symtree->n.sym->attr.allocatable;
coarray = expr->symtree->n.sym->attr.codimension;
}
else
{
- allocatable_array = prev_ref->u.c.component->attr.allocatable;
+ allocatable = prev_ref->u.c.component->attr.allocatable;
coarray = prev_ref->u.c.component->attr.codimension;
}
STRIP_NOPS (pointer);
/* The allocate_array variants take the old pointer as first argument. */
- if (allocatable_array)
- tmp = gfc_allocate_array_with_status (&elseblock, pointer, size, pstat, expr);
+ if (allocatable)
+ tmp = gfc_allocate_allocatable_with_status (&elseblock,
+ pointer, size, pstat, expr);
else
- tmp = gfc_allocate_with_status (&elseblock, size, pstat);
+ tmp = gfc_allocate_with_status (&elseblock, size, pstat, false);
tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, pointer,
tmp);
GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE(decl)));
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_register, 6, size,
- build_int_cst (integer_type_node, 0), /* type. */
+ build_int_cst (integer_type_node,
+ GFC_CAF_COARRAY_ALLOC), /* type. */
token, null_pointer_node, /* token, stat. */
null_pointer_node, /* errgmsg, errmsg_len. */
build_int_cst (integer_type_node, 0));
size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
size, esize);
size = gfc_evaluate_now (fold_convert (size_type_node, size), &cond_block);
- ptr = gfc_allocate_array_with_status (&cond_block,
- build_int_cst (pvoid_type_node, 0),
- size, NULL, NULL);
+ ptr = gfc_allocate_allocatable_with_status (&cond_block,
+ build_int_cst (pvoid_type_node, 0),
+ size, NULL, NULL);
gfc_conv_descriptor_data_set (&cond_block, decl, ptr);
then_b = gfc_finish_block (&cond_block);
size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
size, esize);
size = gfc_evaluate_now (fold_convert (size_type_node, size), &block);
- ptr = gfc_allocate_array_with_status (&block,
- build_int_cst (pvoid_type_node, 0),
- size, NULL, NULL);
+ ptr = gfc_allocate_allocatable_with_status (&block,
+ build_int_cst (pvoid_type_node, 0),
+ size, NULL, NULL);
gfc_conv_descriptor_data_set (&block, dest, ptr);
call = build_call_expr_loc (input_location,
built_in_decls[BUILT_IN_MEMCPY], 3, ptr,
size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
size, esize);
size = gfc_evaluate_now (fold_convert (size_type_node, size), &block);
- ptr = gfc_allocate_array_with_status (&block,
- build_int_cst (pvoid_type_node, 0),
- size, NULL, NULL);
+ ptr = gfc_allocate_allocatable_with_status (&block,
+ build_int_cst (pvoid_type_node, 0),
+ size, NULL, NULL);
gfc_conv_descriptor_data_set (&block, decl, ptr);
gfc_add_expr_to_block (&block, gfc_trans_assignment (e1, e2, false,
false));
/* Allocate - for non-pointers with re-alloc checking. */
if (gfc_expr_attr (expr).allocatable)
- tmp = gfc_allocate_array_with_status (&se.pre, se.expr, memsz,
- pstat, expr);
+ tmp = gfc_allocate_allocatable_with_status (&se.pre, se.expr, memsz,
+ pstat, expr);
else
- tmp = gfc_allocate_with_status (&se.pre, memsz, pstat);
+ tmp = gfc_allocate_with_status (&se.pre, memsz, pstat, false);
tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
se.expr,
return newmem;
} */
tree
-gfc_allocate_with_status (stmtblock_t * block, tree size, tree status)
+gfc_allocate_with_status (stmtblock_t * block, tree size, tree status,
+ bool coarray_lib)
{
stmtblock_t alloc_block;
tree res, tmp, msg, cond;
/* The allocation itself. */
gfc_start_block (&alloc_block);
- gfc_add_modify (&alloc_block, res,
- fold_convert (prvoid_type_node,
- build_call_expr_loc (input_location,
- built_in_decls[BUILT_IN_MALLOC], 1,
- fold_build2_loc (input_location,
- MAX_EXPR, size_type_node, size,
- build_int_cst (size_type_node,
- 1)))));
+ if (coarray_lib)
+ {
+ gfc_add_modify (&alloc_block, res,
+ fold_convert (prvoid_type_node,
+ build_call_expr_loc (input_location,
+ gfor_fndecl_caf_register, 3,
+ fold_build2_loc (input_location,
+ MAX_EXPR, size_type_node, size,
+ build_int_cst (size_type_node, 1)),
+ build_int_cst (integer_type_node,
+ GFC_CAF_COARRAY_ALLOC),
+ null_pointer_node))); /* Token */
+ }
+ else
+ {
+ gfc_add_modify (&alloc_block, res,
+ fold_convert (prvoid_type_node,
+ build_call_expr_loc (input_location,
+ built_in_decls[BUILT_IN_MALLOC], 1,
+ fold_build2_loc (input_location,
+ MAX_EXPR, size_type_node, size,
+ build_int_cst (size_type_node, 1)))));
+ }
msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const
("Allocation would exceed memory limit"));
/* Generate code for an ALLOCATE statement when the argument is an
- allocatable array. If the array is currently allocated, it is an
+ allocatable variable. If the variable is currently allocated, it is an
error to allocate it again.
This function follows the following pseudo-code:
void *
- allocate_array (void *mem, size_t size, integer_type *stat)
+ allocate_allocatable (void *mem, size_t size, integer_type *stat)
{
if (mem == NULL)
return allocate (size, stat);
expr must be set to the original expression being allocated for its locus
and variable name in case a runtime error has to be printed. */
tree
-gfc_allocate_array_with_status (stmtblock_t * block, tree mem, tree size,
- tree status, gfc_expr* expr)
+gfc_allocate_allocatable_with_status (stmtblock_t * block, tree mem, tree size,
+ tree status, gfc_expr* expr)
{
stmtblock_t alloc_block;
tree res, tmp, null_mem, alloc, error;
/* If mem is NULL, we call gfc_allocate_with_status. */
gfc_start_block (&alloc_block);
- tmp = gfc_allocate_with_status (&alloc_block, size, status);
+ tmp = gfc_allocate_with_status (&alloc_block, size, status,
+ gfc_option.coarray == GFC_FCOARRAY_LIB
+ && gfc_expr_attr (expr).codimension);
+
gfc_add_modify (&alloc_block, res, fold_convert (type, tmp));
alloc = gfc_finish_block (&alloc_block);
- /* Otherwise, we issue a runtime error or set the status variable. */
+ /* If mem is not NULL, we issue a runtime error or set the
+ status variable. */
if (expr)
{
tree varname;
fold_convert (pvoid_type_node, mem));
gfc_add_expr_to_block (&set_status_block, tmp);
- tmp = gfc_allocate_with_status (&set_status_block, size, status);
+ tmp = gfc_allocate_with_status (&set_status_block, size, status, false);
gfc_add_modify (&set_status_block, res, fold_convert (type, tmp));
gfc_add_modify (&set_status_block,
gfc_se;
+/* Denotes different types of coarray.
+ Please keep in sync with libgfortran/caf/libcaf.h. */
+typedef enum
+{
+ GFC_CAF_COARRAY_STATIC,
+ GFC_CAF_COARRAY_ALLOC,
+ GFC_CAF_LOCK,
+ GFC_CAF_LOCK_COMP
+}
+gfc_coarray_type;
+
+
/* Scalarization State chain. Created by walking an expression tree before
creating the scalarization loops. Then passed as part of a gfc_se structure
to translate the expression inside the loop. Note that these chains are
/* Build a memcpy call. */
tree gfc_build_memcpy_call (tree, tree, tree);
-/* Allocate memory for arrays, with optional status variable. */
-tree gfc_allocate_array_with_status (stmtblock_t*, tree, tree, tree, gfc_expr*);
+/* Allocate memory for allocatable variables, with optional status variable. */
+tree gfc_allocate_allocatable_with_status (stmtblock_t*,
+ tree, tree, tree, gfc_expr*);
/* Allocate memory, with optional status variable. */
-tree gfc_allocate_with_status (stmtblock_t *, tree, tree);
+tree gfc_allocate_with_status (stmtblock_t *, tree, tree, bool);
/* Generate code to deallocate an array. */
tree gfc_deallocate_with_status (tree, tree, bool, gfc_expr*);
projects / gcc.git / commitdiff