mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-02 08:40:26 +08:00
re PR fortran/30115 (allocate() interface pessimizes aliasing)
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 *). * 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. From-SVN: r119822
This commit is contained in:
parent
691eb42f29
commit
54200abb68
@ -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<68>üter <tobias.schlueter@physik.uni-muenchen.de>
|
||||
|
||||
* trans-expr.c (gfc_conv_substring): Check for empty substring.
|
||||
|
@ -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);
|
||||
}
|
||||
|
||||
|
@ -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 =
|
||||
|
@ -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);
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
|
Loading…
x
Reference in New Issue
Block a user