diff options
author | burnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2011-07-06 20:57:03 +0000 |
---|---|---|
committer | burnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2011-07-06 20:57:03 +0000 |
commit | 7b186db62f7e7500f9b7c5c76237a161d49073da (patch) | |
tree | 036a81e27cd7b393a3be5549a7d7d3aadc196098 /gcc/fortran/trans.c | |
parent | a7fc75f4927756e63512cb06eda7e6efa70f5609 (diff) | |
download | gcc-7b186db62f7e7500f9b7c5c76237a161d49073da.tar.gz |
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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@175937 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/fortran/trans.c')
-rw-r--r-- | gcc/fortran/trans.c | 52 |
1 files changed, 36 insertions, 16 deletions
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 33593c5626a..683e3f1e48b 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -585,7 +585,8 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size) 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; @@ -616,14 +617,29 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status) /* 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")); @@ -658,13 +674,13 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status) /* 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); @@ -685,8 +701,8 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status) 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; @@ -703,11 +719,15 @@ gfc_allocate_array_with_status (stmtblock_t * block, tree mem, tree size, /* 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; @@ -737,7 +757,7 @@ gfc_allocate_array_with_status (stmtblock_t * block, tree mem, tree size, 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, |