diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 13 | ||||
| -rw-r--r-- | gcc/fortran/trans-array.c | 29 | ||||
| -rw-r--r-- | gcc/fortran/trans-decl.c | 22 | ||||
| -rw-r--r-- | gcc/fortran/trans-stmt.c | 23 | ||||
| -rw-r--r-- | libgfortran/ChangeLog | 13 | ||||
| -rw-r--r-- | libgfortran/runtime/memory.c | 106 |
6 files changed, 108 insertions, 98 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index eb9efa1b9cd..fdc054ecfc4 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2006-12-13 Richard Guenther <rguenther@suse.de> + + PR fortran/30115 + * trans-array.c (gfc_array_allocate): Adjust for changed + library interface. + (gfc_array_deallocate): Likewise. + (gfc_trans_dealloc_allocated): Likewise. + * trans-stmt.c (gfc_trans_allocate): Likewise. + (gfc_trans_deallocate): Likewise. + * trans-decl.c (gfc_build_builtin_function_decls): Adjust + function declarations to match the library changes. Mark + allocation functions with DECL_IS_MALLOC. + 2006-12-12 Tobias Schlüter <tobias.schlueter@physik.uni-muenchen.de> * trans-expr.c (gfc_conv_substring): Check for empty substring. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index bfd0600b582..b65ec748f47 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3355,8 +3355,8 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat) lower, upper, &se->pre); /* Allocate memory to store the data. */ - tmp = gfc_conv_descriptor_data_addr (se->expr); - pointer = gfc_evaluate_now (tmp, &se->pre); + pointer = gfc_conv_descriptor_data_get (se->expr); + STRIP_NOPS (pointer); if (TYPE_PRECISION (gfc_array_index_type) == 32) { @@ -3375,10 +3375,14 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat) else gcc_unreachable (); - tmp = gfc_chainon_list (NULL_TREE, pointer); + tmp = NULL_TREE; + /* The allocate_array variants take the old pointer as first argument. */ + if (allocatable_array) + tmp = gfc_chainon_list (tmp, pointer); tmp = gfc_chainon_list (tmp, size); tmp = gfc_chainon_list (tmp, pstat); tmp = build_function_call_expr (allocate, tmp); + tmp = build2 (MODIFY_EXPR, void_type_node, pointer, tmp); gfc_add_expr_to_block (&se->pre, tmp); tmp = gfc_conv_descriptor_offset (se->expr); @@ -3409,8 +3413,8 @@ gfc_array_deallocate (tree descriptor, tree pstat) gfc_start_block (&block); /* Get a pointer to the data. */ - tmp = gfc_conv_descriptor_data_addr (descriptor); - var = gfc_evaluate_now (tmp, &block); + var = gfc_conv_descriptor_data_get (descriptor); + STRIP_NOPS (var); /* Parameter is the address of the data component. */ tmp = gfc_chainon_list (NULL_TREE, var); @@ -3418,6 +3422,11 @@ gfc_array_deallocate (tree descriptor, tree pstat) tmp = build_function_call_expr (gfor_fndecl_deallocate, tmp); gfc_add_expr_to_block (&block, tmp); + /* Zero the data pointer. */ + tmp = build2 (MODIFY_EXPR, void_type_node, + var, build_int_cst (TREE_TYPE (var), 0)); + gfc_add_expr_to_block (&block, tmp); + return gfc_finish_block (&block); } @@ -4690,8 +4699,8 @@ gfc_trans_dealloc_allocated (tree descriptor) gfc_start_block (&block); - tmp = gfc_conv_descriptor_data_addr (descriptor); - var = gfc_evaluate_now (tmp, &block); + var = gfc_conv_descriptor_data_get (descriptor); + STRIP_NOPS (var); tmp = gfc_create_var (gfc_array_index_type, NULL); ptr = build_fold_addr_expr (tmp); @@ -4702,6 +4711,12 @@ gfc_trans_dealloc_allocated (tree descriptor) tmp = gfc_chainon_list (tmp, ptr); tmp = build_function_call_expr (gfor_fndecl_deallocate, tmp); gfc_add_expr_to_block (&block, tmp); + + /* Zero the data pointer. */ + tmp = build2 (MODIFY_EXPR, void_type_node, + var, build_int_cst (TREE_TYPE (var), 0)); + gfc_add_expr_to_block (&block, tmp); + return gfc_finish_block (&block); } diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 67e654c9751..815b15e1016 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2304,27 +2304,31 @@ gfc_build_builtin_function_decls (void) gfor_fndecl_allocate = gfc_build_library_function_decl (get_identifier (PREFIX("allocate")), - void_type_node, 2, ppvoid_type_node, - gfc_int4_type_node); + pvoid_type_node, 2, + gfc_int4_type_node, gfc_pint4_type_node); + DECL_IS_MALLOC (gfor_fndecl_allocate) = 1; gfor_fndecl_allocate64 = gfc_build_library_function_decl (get_identifier (PREFIX("allocate64")), - void_type_node, 2, ppvoid_type_node, - gfc_int8_type_node); + pvoid_type_node, 2, + gfc_int8_type_node, gfc_pint4_type_node); + DECL_IS_MALLOC (gfor_fndecl_allocate64) = 1; gfor_fndecl_allocate_array = gfc_build_library_function_decl (get_identifier (PREFIX("allocate_array")), - void_type_node, 2, ppvoid_type_node, - gfc_int4_type_node); + pvoid_type_node, 3, pvoid_type_node, + gfc_int4_type_node, gfc_pint4_type_node); + DECL_IS_MALLOC (gfor_fndecl_allocate_array) = 1; gfor_fndecl_allocate64_array = gfc_build_library_function_decl (get_identifier (PREFIX("allocate64_array")), - void_type_node, 2, ppvoid_type_node, - gfc_int8_type_node); + pvoid_type_node, 3, pvoid_type_node, + gfc_int8_type_node, gfc_pint4_type_node); + DECL_IS_MALLOC (gfor_fndecl_allocate64_array) = 1; gfor_fndecl_deallocate = gfc_build_library_function_decl (get_identifier (PREFIX("deallocate")), - void_type_node, 2, ppvoid_type_node, + void_type_node, 2, pvoid_type_node, gfc_pint4_type_node); gfor_fndecl_stop_numeric = diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 03ff0fee92b..df853ec264b 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -3571,21 +3571,15 @@ gfc_trans_allocate (gfc_code * code) if (!gfc_array_allocate (&se, expr, pstat)) { /* A scalar or derived type. */ - tree val; - - val = gfc_create_var (ppvoid_type_node, "ptr"); - tmp = gfc_build_addr_expr (ppvoid_type_node, se.expr); - gfc_add_modify_expr (&se.pre, val, tmp); - tmp = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (se.expr))); if (expr->ts.type == BT_CHARACTER && tmp == NULL_TREE) tmp = se.string_length; - parm = gfc_chainon_list (NULL_TREE, val); - parm = gfc_chainon_list (parm, tmp); + parm = gfc_chainon_list (NULL_TREE, tmp); parm = gfc_chainon_list (parm, pstat); tmp = build_function_call_expr (gfor_fndecl_allocate, parm); + tmp = build2 (MODIFY_EXPR, void_type_node, se.expr, tmp); gfc_add_expr_to_block (&se.pre, tmp); if (code->expr) @@ -3650,7 +3644,7 @@ gfc_trans_deallocate (gfc_code * code) gfc_se se; gfc_alloc *al; gfc_expr *expr; - tree apstat, astat, parm, pstat, stat, tmp, type, var; + tree apstat, astat, parm, pstat, stat, tmp; stmtblock_t block; gfc_start_block (&block); @@ -3713,14 +3707,13 @@ gfc_trans_deallocate (gfc_code * code) tmp = gfc_array_deallocate (se.expr, pstat); else { - type = build_pointer_type (TREE_TYPE (se.expr)); - var = gfc_create_var (type, "ptr"); - tmp = gfc_build_addr_expr (type, se.expr); - gfc_add_modify_expr (&se.pre, var, tmp); - - parm = gfc_chainon_list (NULL_TREE, var); + parm = gfc_chainon_list (NULL_TREE, se.expr); parm = gfc_chainon_list (parm, pstat); tmp = build_function_call_expr (gfor_fndecl_deallocate, parm); + gfc_add_expr_to_block (&se.pre, tmp); + + tmp = build2 (MODIFY_EXPR, void_type_node, + se.expr, build_int_cst (TREE_TYPE (se.expr), 0)); } gfc_add_expr_to_block (&se.pre, tmp); diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 6d9739a6f8c..d80cf70f170 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,16 @@ +2006-12-13 Richard Guenther <rguenther@suse.de> + + PR fortran/30115 + * runtime/memory.c (allocate_size): Change interface to + void *()(size_t, GFC_INTEGER_4 *). + (allocate): Likewise. + (allocate64): Likewise. + (allocate_array): Change interface to + void *()(void *, size_t, GFC_INTEGER_4 *). + (allocate64_array): Likewise. + (deallocate): Change interface to + void ()(void *, GFC_INTEGER_4 *). + 2006-12-06 Francois-Xavier Coudert <coudert@clipper.ens.fr> PR libfortran/29810 diff --git a/libgfortran/runtime/memory.c b/libgfortran/runtime/memory.c index 43a72e3f1b2..b38d062669f 100644 --- a/libgfortran/runtime/memory.c +++ b/libgfortran/runtime/memory.c @@ -174,133 +174,110 @@ internal_realloc64 (void *mem, GFC_INTEGER_8 size) /* User-allocate, one call for each member of the alloc-list of an ALLOCATE statement. */ -static void -allocate_size (void **mem, size_t size, GFC_INTEGER_4 * stat) +static void * +allocate_size (size_t size, GFC_INTEGER_4 * stat) { void *newmem; - if (!mem) - runtime_error ("Internal: NULL mem pointer in ALLOCATE."); - newmem = malloc (size ? size : 1); if (!newmem) { if (stat) { *stat = 1; - return; + return newmem; } else runtime_error ("ALLOCATE: Out of memory."); } - (*mem) = newmem; - if (stat) *stat = 0; + + return newmem; } -extern void allocate (void **, GFC_INTEGER_4, GFC_INTEGER_4 *); +extern void *allocate (GFC_INTEGER_4, GFC_INTEGER_4 *); export_proto(allocate); -void -allocate (void **mem, GFC_INTEGER_4 size, GFC_INTEGER_4 * stat) +void * +allocate (GFC_INTEGER_4 size, GFC_INTEGER_4 * stat) { if (size < 0) - { - runtime_error ("Attempt to allocate negative amount of memory. " - "Possible integer overflow"); - abort (); - } + runtime_error ("Attempt to allocate negative amount of memory. " + "Possible integer overflow"); - allocate_size (mem, (size_t) size, stat); + return allocate_size ((size_t) size, stat); } -extern void allocate64 (void **, GFC_INTEGER_8, GFC_INTEGER_4 *); +extern void *allocate64 (GFC_INTEGER_8, GFC_INTEGER_4 *); export_proto(allocate64); -void -allocate64 (void **mem, GFC_INTEGER_8 size, GFC_INTEGER_4 * stat) +void * +allocate64 (GFC_INTEGER_8 size, GFC_INTEGER_4 * stat) { if (size < 0) - { - runtime_error - ("ALLOCATE64: Attempt to allocate negative amount of memory. " - "Possible integer overflow"); - abort (); - } + runtime_error ("ALLOCATE64: Attempt to allocate negative amount of " + "memory. Possible integer overflow"); - allocate_size (mem, (size_t) size, stat); + return allocate_size ((size_t) size, stat); } /* Function to call in an ALLOCATE statement when the argument is an allocatable array. If the array is currently allocated, it is an error to allocate it again. 32-bit version. */ -extern void allocate_array (void **, GFC_INTEGER_4, GFC_INTEGER_4 *); +extern void *allocate_array (void *, GFC_INTEGER_4, GFC_INTEGER_4 *); export_proto(allocate_array); -void -allocate_array (void **mem, GFC_INTEGER_4 size, GFC_INTEGER_4 * stat) +void * +allocate_array (void *mem, GFC_INTEGER_4 size, GFC_INTEGER_4 * stat) { - if (*mem == NULL) - { - allocate (mem, size, stat); - return; - } + if (mem == NULL) + return allocate (size, stat); if (stat) { - free (*mem); - allocate (mem, size, stat); + free (mem); + mem = allocate (size, stat); *stat = ERROR_ALLOCATION; - return; + return mem; } - else - runtime_error ("Attempting to allocate already allocated array."); - return; + runtime_error ("Attempting to allocate already allocated array."); } /* Function to call in an ALLOCATE statement when the argument is an allocatable array. If the array is currently allocated, it is an error to allocate it again. 64-bit version. */ -extern void allocate64_array (void **, GFC_INTEGER_8, GFC_INTEGER_4 *); +extern void *allocate64_array (void *, GFC_INTEGER_8, GFC_INTEGER_4 *); export_proto(allocate64_array); -void -allocate64_array (void **mem, GFC_INTEGER_8 size, GFC_INTEGER_4 * stat) +void * +allocate64_array (void *mem, GFC_INTEGER_8 size, GFC_INTEGER_4 * stat) { - if (*mem == NULL) - { - allocate64 (mem, size, stat); - return; - } + if (mem == NULL) + return allocate64 (size, stat); if (stat) { - free (*mem); - allocate (mem, size, stat); + free (mem); + mem = allocate (size, stat); *stat = ERROR_ALLOCATION; - return; + return mem; } - else - runtime_error ("Attempting to allocate already allocated array."); - return; + runtime_error ("Attempting to allocate already allocated array."); } /* User-deallocate; pointer is NULLified. */ -extern void deallocate (void **, GFC_INTEGER_4 *); +extern void deallocate (void *, GFC_INTEGER_4 *); export_proto(deallocate); void -deallocate (void **mem, GFC_INTEGER_4 * stat) +deallocate (void *mem, GFC_INTEGER_4 * stat) { if (!mem) - runtime_error ("Internal: NULL mem pointer in DEALLOCATE."); - - if (!*mem) { if (stat) { @@ -308,15 +285,10 @@ deallocate (void **mem, GFC_INTEGER_4 * stat) return; } else - { - runtime_error - ("Internal: Attempt to DEALLOCATE unallocated memory."); - abort (); - } + runtime_error ("Internal: Attempt to DEALLOCATE unallocated memory."); } - free (*mem); - *mem = NULL; + free (mem); if (stat) *stat = 0; |