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:
Richard Guenther 2006-12-13 09:57:56 +00:00 committed by Richard Biener
parent 691eb42f29
commit 54200abb68
6 changed files with 108 additions and 98 deletions

View File

@ -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.

View File

@ -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);
}

View File

@ -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 =

View File

@ -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);

View File

@ -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

View File

@ -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;