diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 23 | ||||
| -rw-r--r-- | gcc/fortran/trans-array.c | 33 | ||||
| -rw-r--r-- | gcc/fortran/trans-array.h | 2 | ||||
| -rw-r--r-- | gcc/fortran/trans-openmp.c | 18 | ||||
| -rw-r--r-- | gcc/fortran/trans-stmt.c | 104 | ||||
| -rw-r--r-- | gcc/fortran/trans.c | 188 | ||||
| -rw-r--r-- | gcc/fortran/trans.h | 7 |
7 files changed, 224 insertions, 151 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a28a8fa..dd4cd8d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,26 @@ +2011-07-21 Daniel Carrera <dcarrera@gmail.com> + + * trans.c (gfc_allocate_with_status): Split into two functions + gfc_allocate_using_malloc and gfc_allocate_usig_lib. + (gfc_allocate_using_malloc): The status parameter is now the + actual status rather than a pointer. Code cleanup. + (gfc_allocate_using_lib): Ditto. Add new parametrs errmsg and + errlen. Pass these to the coarray lib. + * trans-openmp.c (gfc_omp_clause_default_ctor): Update calls to + gfc_allocate_allocatable. + (gfc_omp_clause_copy_ctor): Ditto. + (gfc_trans_omp_array_reduction): Ditto. + * trans-stmt.c (gfc_trans_allocate): Ditto. Update call to + gfc_allocate_using_malloc. Pass stat rather than pstat to the allocate + fuctions. If using coarray lib, pass errmsg and errlen to the allocate + functions. Move error checking outside the if (!gfc_array_allocate) + block so that it also affects trees produced by gfc_array_allocate. + * trans-array.c (gfc_array_allocate): Add new parameters errmsg + and errlen. Replace parameter pstat by status. Code cleanup. Update + calls to gfc_allocate_allocatable and gfc_allocate_using_malloc. + * trans-array.h (gfc_array_allocate): Update signature of + gfc_array_allocate. + 2011-07-21 Steven G. Kargl <kargl@gcc.gnu.org> * gfortran.texi: Remove a duplicate word. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 9caa17f..b959b36 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -4383,7 +4383,8 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset, /*GCC ARRAYS*/ bool -gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat) +gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, + tree errlen) { tree tmp; tree pointer; @@ -4478,22 +4479,15 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat) 1, msg); } - if (pstat != NULL_TREE && !integer_zerop (pstat)) + if (status != NULL_TREE) { - /* Set the status variable if it's present. */ + tree status_type = TREE_TYPE (status); stmtblock_t set_status_block; - tree status_type = pstat ? TREE_TYPE (TREE_TYPE (pstat)) : NULL_TREE; gfc_start_block (&set_status_block); - gfc_add_modify (&set_status_block, - fold_build1_loc (input_location, INDIRECT_REF, - status_type, pstat), - build_int_cst (status_type, LIBERROR_ALLOCATION)); - - tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, - pstat, build_int_cst (TREE_TYPE (pstat), 0)); - error = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp, - error, gfc_finish_block (&set_status_block)); + gfc_add_modify (&set_status_block, status, + build_int_cst (status_type, LIBERROR_ALLOCATION)); + error = gfc_finish_block (&set_status_block); } gfc_start_block (&elseblock); @@ -4502,14 +4496,15 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat) pointer = gfc_conv_descriptor_data_get (se->expr); STRIP_NOPS (pointer); - /* The allocate_array variants take the old pointer as first argument. */ + /* The allocatable variant takes the old pointer as first argument. */ if (allocatable) - tmp = gfc_allocate_allocatable_with_status (&elseblock, - pointer, size, pstat, expr); + tmp = gfc_allocate_allocatable (&elseblock, pointer, size, + status, errmsg, errlen, expr); else - tmp = gfc_allocate_with_status (&elseblock, size, pstat, false); - tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, pointer, - tmp); + tmp = gfc_allocate_using_malloc (&elseblock, size, status); + + tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, + pointer, tmp); gfc_add_expr_to_block (&elseblock, tmp); diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index f29162e..75704ad 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -24,7 +24,7 @@ tree gfc_array_deallocate (tree, tree, gfc_expr*); /* Generate code to initialize an 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); +bool gfc_array_allocate (gfc_se *, gfc_expr *, tree, tree, tree); /* 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-openmp.c b/gcc/fortran/trans-openmp.c index aff8554..cd5ef0a 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -188,9 +188,9 @@ gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer) 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_allocatable_with_status (&cond_block, - build_int_cst (pvoid_type_node, 0), - size, NULL, NULL); + ptr = gfc_allocate_allocatable (&cond_block, + build_int_cst (pvoid_type_node, 0), + size, NULL_TREE, NULL_TREE, NULL_TREE, NULL); gfc_conv_descriptor_data_set (&cond_block, decl, ptr); then_b = gfc_finish_block (&cond_block); @@ -241,9 +241,9 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src) 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_allocatable_with_status (&block, - build_int_cst (pvoid_type_node, 0), - size, NULL, NULL); + ptr = gfc_allocate_allocatable (&block, + build_int_cst (pvoid_type_node, 0), + size, NULL_TREE, NULL_TREE, NULL_TREE, NULL); gfc_conv_descriptor_data_set (&block, dest, ptr); call = build_call_expr_loc (input_location, built_in_decls[BUILT_IN_MEMCPY], 3, ptr, @@ -663,9 +663,9 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where) 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_allocatable_with_status (&block, - build_int_cst (pvoid_type_node, 0), - size, NULL, NULL); + ptr = gfc_allocate_allocatable (&block, + build_int_cst (pvoid_type_node, 0), + size, NULL_TREE, NULL_TREE, NULL_TREE, NULL); gfc_conv_descriptor_data_set (&block, decl, ptr); gfc_add_expr_to_block (&block, gfc_trans_assignment (e1, e2, false, false)); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 1da3a06..75d72a2 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -4686,8 +4686,10 @@ gfc_trans_allocate (gfc_code * code) tree tmp; tree parm; tree stat; - tree pstat; - tree error_label; + tree errmsg; + tree errlen; + tree label_errmsg; + tree label_finish; tree memsz; tree expr3; tree slen3; @@ -4699,21 +4701,39 @@ gfc_trans_allocate (gfc_code * code) if (!code->ext.alloc.list) return NULL_TREE; - pstat = stat = error_label = tmp = memsz = NULL_TREE; + stat = tmp = memsz = NULL_TREE; + label_errmsg = label_finish = errmsg = errlen = NULL_TREE; gfc_init_block (&block); gfc_init_block (&post); - /* Either STAT= and/or ERRMSG is present. */ - if (code->expr1 || code->expr2) + /* STAT= (and maybe ERRMSG=) is present. */ + if (code->expr1) { + /* STAT=. */ tree gfc_int4_type_node = gfc_get_int_type (4); - stat = gfc_create_var (gfc_int4_type_node, "stat"); - pstat = gfc_build_addr_expr (NULL_TREE, stat); - error_label = gfc_build_label_decl (NULL_TREE); - TREE_USED (error_label) = 1; + /* ERRMSG= only makes sense with STAT=. */ + if (code->expr2) + { + gfc_init_se (&se, NULL); + gfc_conv_expr_lhs (&se, code->expr2); + + errlen = gfc_get_expr_charlen (code->expr2); + errmsg = gfc_build_addr_expr (pchar_type_node, se.expr); + } + else + { + errmsg = null_pointer_node; + errlen = build_int_cst (gfc_charlen_type_node, 0); + } + + /* GOTO destinations. */ + label_errmsg = gfc_build_label_decl (NULL_TREE); + label_finish = gfc_build_label_decl (NULL_TREE); + TREE_USED (label_errmsg) = 1; + TREE_USED (label_finish) = 1; } expr3 = NULL_TREE; @@ -4732,7 +4752,7 @@ gfc_trans_allocate (gfc_code * code) se.descriptor_only = 1; gfc_conv_expr (&se, expr); - if (!gfc_array_allocate (&se, expr, pstat)) + if (!gfc_array_allocate (&se, expr, stat, errmsg, errlen)) { /* A scalar or derived type. */ @@ -4847,28 +4867,16 @@ gfc_trans_allocate (gfc_code * code) /* Allocate - for non-pointers with re-alloc checking. */ if (gfc_expr_attr (expr).allocatable) - tmp = gfc_allocate_allocatable_with_status (&se.pre, se.expr, memsz, - pstat, expr); + tmp = gfc_allocate_allocatable (&se.pre, se.expr, memsz, + stat, errmsg, errlen, expr); else - tmp = gfc_allocate_with_status (&se.pre, memsz, pstat, false); + tmp = gfc_allocate_using_malloc (&se.pre, memsz, stat); tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, se.expr, fold_convert (TREE_TYPE (se.expr), tmp)); gfc_add_expr_to_block (&se.pre, tmp); - if (code->expr1 || code->expr2) - { - tmp = build1_v (GOTO_EXPR, error_label); - parm = fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, stat, - build_int_cst (TREE_TYPE (stat), 0)); - tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, - parm, tmp, - build_empty_stmt (input_location)); - gfc_add_expr_to_block (&se.pre, tmp); - } - if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp) { tmp = build_fold_indirect_ref_loc (input_location, se.expr); @@ -4879,6 +4887,25 @@ gfc_trans_allocate (gfc_code * code) gfc_add_block_to_block (&block, &se.pre); + /* Error checking -- Note: ERRMSG only makes sense with STAT. */ + if (code->expr1) + { + /* The coarray library already sets the errmsg. */ + if (gfc_option.coarray == GFC_FCOARRAY_LIB + && gfc_expr_attr (expr).codimension) + tmp = build1_v (GOTO_EXPR, label_finish); + else + tmp = build1_v (GOTO_EXPR, label_errmsg); + + parm = fold_build2_loc (input_location, NE_EXPR, + boolean_type_node, stat, + build_int_cst (TREE_TYPE (stat), 0)); + tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, + parm, tmp, + build_empty_stmt (input_location)); + gfc_add_expr_to_block (&block, tmp); + } + if (code->expr3 && !code->expr3->mold) { /* Initialization via SOURCE block @@ -5005,16 +5032,11 @@ gfc_trans_allocate (gfc_code * code) } - /* STAT block. */ + /* STAT (ERRMSG only makes sense with STAT). */ if (code->expr1) { - tmp = build1_v (LABEL_EXPR, error_label); + tmp = build1_v (LABEL_EXPR, label_errmsg); gfc_add_expr_to_block (&block, tmp); - - gfc_init_se (&se, NULL); - gfc_conv_expr_lhs (&se, code->expr1); - tmp = convert (TREE_TYPE (se.expr), stat); - gfc_add_modify (&block, se.expr, tmp); } /* ERRMSG block. */ @@ -5022,7 +5044,7 @@ gfc_trans_allocate (gfc_code * code) { /* A better error message may be possible, but not required. */ const char *msg = "Attempt to allocate an allocated object"; - tree errmsg, slen, dlen; + tree slen, dlen; gfc_init_se (&se, NULL); gfc_conv_expr_lhs (&se, code->expr2); @@ -5050,6 +5072,22 @@ gfc_trans_allocate (gfc_code * code) gfc_add_expr_to_block (&block, tmp); } + /* STAT (ERRMSG only makes sense with STAT). */ + if (code->expr1) + { + tmp = build1_v (LABEL_EXPR, label_finish); + gfc_add_expr_to_block (&block, tmp); + } + + /* STAT block. */ + if (code->expr1) + { + gfc_init_se (&se, NULL); + gfc_conv_expr_lhs (&se, code->expr1); + tmp = convert (TREE_TYPE (se.expr), stat); + gfc_add_modify (&block, se.expr, tmp); + } + gfc_add_block_to_block (&block, &se.post); gfc_add_block_to_block (&block, &post); diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 578f225..83fabe2 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -565,12 +565,12 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size) This function follows the following pseudo-code: void * - allocate (size_t size, integer_type* stat) + allocate (size_t size, integer_type stat) { void *newmem; - if (stat) - *stat = 0; + if (stat requested) + stat = 0; newmem = malloc (MAX (size, 1)); if (newmem == NULL) @@ -583,12 +583,11 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size) return newmem; } */ tree -gfc_allocate_with_status (stmtblock_t * block, tree size, tree status, - bool coarray_lib) +gfc_allocate_using_malloc (stmtblock_t * block, tree size, tree status) { stmtblock_t alloc_block; - tree res, tmp, msg, cond; - tree status_type = status ? TREE_TYPE (TREE_TYPE (status)) : NULL_TREE; + tree res, tmp, on_error; + tree status_type = status ? TREE_TYPE (status) : NULL_TREE; /* Evaluate size only once, and make sure it has the right type. */ size = gfc_evaluate_now (size, block); @@ -599,74 +598,37 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status, res = gfc_create_var (prvoid_type_node, NULL); /* Set the optional status variable to zero. */ - if (status != NULL_TREE && !integer_zerop (status)) - { - tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type, - fold_build1_loc (input_location, INDIRECT_REF, - status_type, status), - build_int_cst (status_type, 0)); - tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, - fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, status, - build_int_cst (TREE_TYPE (status), 0)), - tmp, build_empty_stmt (input_location)); - gfc_add_expr_to_block (block, tmp); - } + if (status != NULL_TREE) + gfc_add_expr_to_block (block, + fold_build2_loc (input_location, MODIFY_EXPR, status_type, + status, build_int_cst (status_type, 0))); /* The allocation itself. */ gfc_start_block (&alloc_block); - if (coarray_lib) - { - gfc_add_modify (&alloc_block, res, - fold_convert (prvoid_type_node, - build_call_expr_loc (input_location, - gfor_fndecl_caf_register, 6, - 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 */ - null_pointer_node, /* stat */ - null_pointer_node, /* errmsg, errmsg_len */ - build_int_cst (integer_type_node, 0)))); - } + 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))))); + + /* What to do in case of error. */ + if (status != NULL_TREE) + on_error = fold_build2_loc (input_location, MODIFY_EXPR, status_type, + status, build_int_cst (status_type, LIBERROR_ALLOCATION)); 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")); - tmp = build_call_expr_loc (input_location, - gfor_fndecl_os_error, 1, msg); - - if (status != NULL_TREE && !integer_zerop (status)) - { - /* Set the status variable if it's present. */ - tree tmp2; - - cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, - status, build_int_cst (TREE_TYPE (status), 0)); - tmp2 = fold_build2_loc (input_location, MODIFY_EXPR, status_type, - fold_build1_loc (input_location, INDIRECT_REF, - status_type, status), - build_int_cst (status_type, LIBERROR_ALLOCATION)); - tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, - tmp, tmp2); - } + on_error = build_call_expr_loc (input_location, gfor_fndecl_os_error, 1, + gfc_build_addr_expr (pchar_type_node, + gfc_build_localized_cstring_const + ("Allocation would exceed memory limit"))); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, res, build_int_cst (prvoid_type_node, 0)), - tmp, build_empty_stmt (input_location)); + on_error, build_empty_stmt (input_location)); + gfc_add_expr_to_block (&alloc_block, tmp); gfc_add_expr_to_block (block, gfc_finish_block (&alloc_block)); @@ -674,6 +636,61 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status, } +/* Allocate memory, using an optional status argument. + + This function follows the following pseudo-code: + + void * + allocate (size_t size, integer_type stat) + { + void *newmem; + + newmem = _caf_register ( size, regtype, NULL, &stat, NULL, NULL); + return newmem; + } */ +tree +gfc_allocate_using_lib (stmtblock_t * block, tree size, tree status, + tree errmsg, tree errlen) +{ + tree res, pstat; + + /* Evaluate size only once, and make sure it has the right type. */ + size = gfc_evaluate_now (size, block); + if (TREE_TYPE (size) != TREE_TYPE (size_type_node)) + size = fold_convert (size_type_node, size); + + /* Create a variable to hold the result. */ + res = gfc_create_var (prvoid_type_node, NULL); + + /* The allocation itself. */ + if (status == NULL_TREE) + pstat = null_pointer_node; + else + pstat = gfc_build_addr_expr (NULL_TREE, status); + + if (errmsg == NULL_TREE) + { + gcc_assert(errlen == NULL_TREE); + errmsg = null_pointer_node; + errlen = build_int_cst (integer_type_node, 0); + } + + gfc_add_modify (block, res, + fold_convert (prvoid_type_node, + build_call_expr_loc (input_location, + gfor_fndecl_caf_register, 6, + 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 */ + pstat, errmsg, errlen))); + + return res; +} + + /* Generate code for an ALLOCATE statement when the argument is an allocatable variable. If the variable is currently allocated, it is an error to allocate it again. @@ -681,7 +698,7 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status, This function follows the following pseudo-code: void * - allocate_allocatable (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); @@ -691,7 +708,7 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status, { free (mem); mem = allocate (size, stat); - *stat = LIBERROR_ALLOCATION; + stat = LIBERROR_ALLOCATION; return mem; } else @@ -702,8 +719,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_allocatable_with_status (stmtblock_t * block, tree mem, tree size, - tree status, gfc_expr* expr) +gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree status, + tree errmsg, tree errlen, gfc_expr* expr) { stmtblock_t alloc_block; tree res, tmp, null_mem, alloc, error; @@ -718,11 +735,16 @@ gfc_allocate_allocatable_with_status (stmtblock_t * block, tree mem, tree size, boolean_type_node, mem, build_int_cst (type, 0))); - /* If mem is NULL, we call gfc_allocate_with_status. */ + /* If mem is NULL, we call gfc_allocate_using_malloc or + gfc_allocate_using_lib. */ gfc_start_block (&alloc_block); - tmp = gfc_allocate_with_status (&alloc_block, size, status, - gfc_option.coarray == GFC_FCOARRAY_LIB - && gfc_expr_attr (expr).codimension); + + if (gfc_option.coarray == GFC_FCOARRAY_LIB + && gfc_expr_attr (expr).codimension) + tmp = gfc_allocate_using_lib (&alloc_block, size, status, + errmsg, errlen); + else + tmp = gfc_allocate_using_malloc (&alloc_block, size, status); gfc_add_modify (&alloc_block, res, fold_convert (type, tmp)); alloc = gfc_finish_block (&alloc_block); @@ -747,9 +769,9 @@ gfc_allocate_allocatable_with_status (stmtblock_t * block, tree mem, tree size, "Attempting to allocate already allocated" " variable"); - if (status != NULL_TREE && !integer_zerop (status)) + if (status != NULL_TREE) { - tree status_type = TREE_TYPE (TREE_TYPE (status)); + tree status_type = TREE_TYPE (status); stmtblock_t set_status_block; gfc_start_block (&set_status_block); @@ -758,18 +780,12 @@ gfc_allocate_allocatable_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, false); + tmp = gfc_allocate_using_malloc (&set_status_block, size, status); gfc_add_modify (&set_status_block, res, fold_convert (type, tmp)); - gfc_add_modify (&set_status_block, - fold_build1_loc (input_location, INDIRECT_REF, - status_type, status), - build_int_cst (status_type, LIBERROR_ALLOCATION)); - - tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, - status, build_int_cst (status_type, 0)); - error = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp, - error, gfc_finish_block (&set_status_block)); + gfc_add_modify (&set_status_block, status, + build_int_cst (status_type, LIBERROR_ALLOCATION)); + error = gfc_finish_block (&set_status_block); } tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, null_mem, diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 48e054f..73e2fa0 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -541,11 +541,12 @@ tree gfc_call_malloc (stmtblock_t *, tree, tree); tree gfc_build_memcpy_call (tree, tree, tree); /* Allocate memory for allocatable variables, with optional status variable. */ -tree gfc_allocate_allocatable_with_status (stmtblock_t*, - tree, tree, tree, gfc_expr*); +tree gfc_allocate_allocatable (stmtblock_t*, tree, tree, + tree, tree, tree, gfc_expr*); /* Allocate memory, with optional status variable. */ -tree gfc_allocate_with_status (stmtblock_t *, tree, tree, bool); +tree gfc_allocate_using_malloc (stmtblock_t *, tree, tree); +tree gfc_allocate_using_lib (stmtblock_t *, tree, tree, tree, tree); /* Generate code to deallocate an array. */ tree gfc_deallocate_with_status (tree, tree, bool, gfc_expr*); |