Commit 54200abb by Richard Guenther Committed by Richard Biener

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
parent 691eb42f
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 Schlter <tobias.schlueter@physik.uni-muenchen.de> 2006-12-12 Tobias Schlter <tobias.schlueter@physik.uni-muenchen.de>
* trans-expr.c (gfc_conv_substring): Check for empty substring. * 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) ...@@ -3355,8 +3355,8 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat)
lower, upper, &se->pre); lower, upper, &se->pre);
/* Allocate memory to store the data. */ /* Allocate memory to store the data. */
tmp = gfc_conv_descriptor_data_addr (se->expr); pointer = gfc_conv_descriptor_data_get (se->expr);
pointer = gfc_evaluate_now (tmp, &se->pre); STRIP_NOPS (pointer);
if (TYPE_PRECISION (gfc_array_index_type) == 32) if (TYPE_PRECISION (gfc_array_index_type) == 32)
{ {
...@@ -3375,10 +3375,14 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat) ...@@ -3375,10 +3375,14 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat)
else else
gcc_unreachable (); 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, size);
tmp = gfc_chainon_list (tmp, pstat); tmp = gfc_chainon_list (tmp, pstat);
tmp = build_function_call_expr (allocate, tmp); tmp = build_function_call_expr (allocate, tmp);
tmp = build2 (MODIFY_EXPR, void_type_node, pointer, tmp);
gfc_add_expr_to_block (&se->pre, tmp); gfc_add_expr_to_block (&se->pre, tmp);
tmp = gfc_conv_descriptor_offset (se->expr); tmp = gfc_conv_descriptor_offset (se->expr);
...@@ -3409,8 +3413,8 @@ gfc_array_deallocate (tree descriptor, tree pstat) ...@@ -3409,8 +3413,8 @@ gfc_array_deallocate (tree descriptor, tree pstat)
gfc_start_block (&block); gfc_start_block (&block);
/* Get a pointer to the data. */ /* Get a pointer to the data. */
tmp = gfc_conv_descriptor_data_addr (descriptor); var = gfc_conv_descriptor_data_get (descriptor);
var = gfc_evaluate_now (tmp, &block); STRIP_NOPS (var);
/* Parameter is the address of the data component. */ /* Parameter is the address of the data component. */
tmp = gfc_chainon_list (NULL_TREE, var); tmp = gfc_chainon_list (NULL_TREE, var);
...@@ -3418,6 +3422,11 @@ gfc_array_deallocate (tree descriptor, tree pstat) ...@@ -3418,6 +3422,11 @@ gfc_array_deallocate (tree descriptor, tree pstat)
tmp = build_function_call_expr (gfor_fndecl_deallocate, tmp); tmp = build_function_call_expr (gfor_fndecl_deallocate, tmp);
gfc_add_expr_to_block (&block, 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); return gfc_finish_block (&block);
} }
...@@ -4690,8 +4699,8 @@ gfc_trans_dealloc_allocated (tree descriptor) ...@@ -4690,8 +4699,8 @@ gfc_trans_dealloc_allocated (tree descriptor)
gfc_start_block (&block); gfc_start_block (&block);
tmp = gfc_conv_descriptor_data_addr (descriptor); var = gfc_conv_descriptor_data_get (descriptor);
var = gfc_evaluate_now (tmp, &block); STRIP_NOPS (var);
tmp = gfc_create_var (gfc_array_index_type, NULL); tmp = gfc_create_var (gfc_array_index_type, NULL);
ptr = build_fold_addr_expr (tmp); ptr = build_fold_addr_expr (tmp);
...@@ -4702,6 +4711,12 @@ gfc_trans_dealloc_allocated (tree descriptor) ...@@ -4702,6 +4711,12 @@ gfc_trans_dealloc_allocated (tree descriptor)
tmp = gfc_chainon_list (tmp, ptr); tmp = gfc_chainon_list (tmp, ptr);
tmp = build_function_call_expr (gfor_fndecl_deallocate, tmp); tmp = build_function_call_expr (gfor_fndecl_deallocate, tmp);
gfc_add_expr_to_block (&block, 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); return gfc_finish_block (&block);
} }
......
...@@ -2304,27 +2304,31 @@ gfc_build_builtin_function_decls (void) ...@@ -2304,27 +2304,31 @@ gfc_build_builtin_function_decls (void)
gfor_fndecl_allocate = gfor_fndecl_allocate =
gfc_build_library_function_decl (get_identifier (PREFIX("allocate")), gfc_build_library_function_decl (get_identifier (PREFIX("allocate")),
void_type_node, 2, ppvoid_type_node, pvoid_type_node, 2,
gfc_int4_type_node); gfc_int4_type_node, gfc_pint4_type_node);
DECL_IS_MALLOC (gfor_fndecl_allocate) = 1;
gfor_fndecl_allocate64 = gfor_fndecl_allocate64 =
gfc_build_library_function_decl (get_identifier (PREFIX("allocate64")), gfc_build_library_function_decl (get_identifier (PREFIX("allocate64")),
void_type_node, 2, ppvoid_type_node, pvoid_type_node, 2,
gfc_int8_type_node); gfc_int8_type_node, gfc_pint4_type_node);
DECL_IS_MALLOC (gfor_fndecl_allocate64) = 1;
gfor_fndecl_allocate_array = gfor_fndecl_allocate_array =
gfc_build_library_function_decl (get_identifier (PREFIX("allocate_array")), gfc_build_library_function_decl (get_identifier (PREFIX("allocate_array")),
void_type_node, 2, ppvoid_type_node, pvoid_type_node, 3, pvoid_type_node,
gfc_int4_type_node); gfc_int4_type_node, gfc_pint4_type_node);
DECL_IS_MALLOC (gfor_fndecl_allocate_array) = 1;
gfor_fndecl_allocate64_array = gfor_fndecl_allocate64_array =
gfc_build_library_function_decl (get_identifier (PREFIX("allocate64_array")), gfc_build_library_function_decl (get_identifier (PREFIX("allocate64_array")),
void_type_node, 2, ppvoid_type_node, pvoid_type_node, 3, pvoid_type_node,
gfc_int8_type_node); gfc_int8_type_node, gfc_pint4_type_node);
DECL_IS_MALLOC (gfor_fndecl_allocate64_array) = 1;
gfor_fndecl_deallocate = gfor_fndecl_deallocate =
gfc_build_library_function_decl (get_identifier (PREFIX("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); gfc_pint4_type_node);
gfor_fndecl_stop_numeric = gfor_fndecl_stop_numeric =
......
...@@ -3571,21 +3571,15 @@ gfc_trans_allocate (gfc_code * code) ...@@ -3571,21 +3571,15 @@ gfc_trans_allocate (gfc_code * code)
if (!gfc_array_allocate (&se, expr, pstat)) if (!gfc_array_allocate (&se, expr, pstat))
{ {
/* A scalar or derived type. */ /* 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))); tmp = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (se.expr)));
if (expr->ts.type == BT_CHARACTER && tmp == NULL_TREE) if (expr->ts.type == BT_CHARACTER && tmp == NULL_TREE)
tmp = se.string_length; tmp = se.string_length;
parm = gfc_chainon_list (NULL_TREE, val); parm = gfc_chainon_list (NULL_TREE, tmp);
parm = gfc_chainon_list (parm, tmp);
parm = gfc_chainon_list (parm, pstat); parm = gfc_chainon_list (parm, pstat);
tmp = build_function_call_expr (gfor_fndecl_allocate, parm); 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); gfc_add_expr_to_block (&se.pre, tmp);
if (code->expr) if (code->expr)
...@@ -3650,7 +3644,7 @@ gfc_trans_deallocate (gfc_code * code) ...@@ -3650,7 +3644,7 @@ gfc_trans_deallocate (gfc_code * code)
gfc_se se; gfc_se se;
gfc_alloc *al; gfc_alloc *al;
gfc_expr *expr; gfc_expr *expr;
tree apstat, astat, parm, pstat, stat, tmp, type, var; tree apstat, astat, parm, pstat, stat, tmp;
stmtblock_t block; stmtblock_t block;
gfc_start_block (&block); gfc_start_block (&block);
...@@ -3713,14 +3707,13 @@ gfc_trans_deallocate (gfc_code * code) ...@@ -3713,14 +3707,13 @@ gfc_trans_deallocate (gfc_code * code)
tmp = gfc_array_deallocate (se.expr, pstat); tmp = gfc_array_deallocate (se.expr, pstat);
else else
{ {
type = build_pointer_type (TREE_TYPE (se.expr)); parm = gfc_chainon_list (NULL_TREE, 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 (parm, pstat); parm = gfc_chainon_list (parm, pstat);
tmp = build_function_call_expr (gfor_fndecl_deallocate, parm); 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); gfc_add_expr_to_block (&se.pre, tmp);
......
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> 2006-12-06 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR libfortran/29810 PR libfortran/29810
......
...@@ -174,133 +174,110 @@ internal_realloc64 (void *mem, GFC_INTEGER_8 size) ...@@ -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 /* User-allocate, one call for each member of the alloc-list of an
ALLOCATE statement. */ ALLOCATE statement. */
static void static void *
allocate_size (void **mem, size_t size, GFC_INTEGER_4 * stat) allocate_size (size_t size, GFC_INTEGER_4 * stat)
{ {
void *newmem; void *newmem;
if (!mem)
runtime_error ("Internal: NULL mem pointer in ALLOCATE.");
newmem = malloc (size ? size : 1); newmem = malloc (size ? size : 1);
if (!newmem) if (!newmem)
{ {
if (stat) if (stat)
{ {
*stat = 1; *stat = 1;
return; return newmem;
} }
else else
runtime_error ("ALLOCATE: Out of memory."); runtime_error ("ALLOCATE: Out of memory.");
} }
(*mem) = newmem;
if (stat) if (stat)
*stat = 0; *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); export_proto(allocate);
void void *
allocate (void **mem, GFC_INTEGER_4 size, GFC_INTEGER_4 * stat) allocate (GFC_INTEGER_4 size, GFC_INTEGER_4 * stat)
{ {
if (size < 0) if (size < 0)
{ runtime_error ("Attempt to allocate negative amount of memory. "
runtime_error ("Attempt to allocate negative amount of memory. " "Possible integer overflow");
"Possible integer overflow");
abort ();
}
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); export_proto(allocate64);
void void *
allocate64 (void **mem, GFC_INTEGER_8 size, GFC_INTEGER_4 * stat) allocate64 (GFC_INTEGER_8 size, GFC_INTEGER_4 * stat)
{ {
if (size < 0) if (size < 0)
{ runtime_error ("ALLOCATE64: Attempt to allocate negative amount of "
runtime_error "memory. Possible integer overflow");
("ALLOCATE64: Attempt to allocate negative amount of memory. "
"Possible integer overflow");
abort ();
}
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 /* Function to call in an ALLOCATE statement when the argument is an
allocatable array. If the array is currently allocated, it is allocatable array. If the array is currently allocated, it is
an error to allocate it again. 32-bit version. */ 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); export_proto(allocate_array);
void void *
allocate_array (void **mem, GFC_INTEGER_4 size, GFC_INTEGER_4 * stat) allocate_array (void *mem, GFC_INTEGER_4 size, GFC_INTEGER_4 * stat)
{ {
if (*mem == NULL) if (mem == NULL)
{ return allocate (size, stat);
allocate (mem, size, stat);
return;
}
if (stat) if (stat)
{ {
free (*mem); free (mem);
allocate (mem, size, stat); mem = allocate (size, stat);
*stat = ERROR_ALLOCATION; *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 /* Function to call in an ALLOCATE statement when the argument is an
allocatable array. If the array is currently allocated, it is allocatable array. If the array is currently allocated, it is
an error to allocate it again. 64-bit version. */ 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); export_proto(allocate64_array);
void void *
allocate64_array (void **mem, GFC_INTEGER_8 size, GFC_INTEGER_4 * stat) allocate64_array (void *mem, GFC_INTEGER_8 size, GFC_INTEGER_4 * stat)
{ {
if (*mem == NULL) if (mem == NULL)
{ return allocate64 (size, stat);
allocate64 (mem, size, stat);
return;
}
if (stat) if (stat)
{ {
free (*mem); free (mem);
allocate (mem, size, stat); mem = allocate (size, stat);
*stat = ERROR_ALLOCATION; *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. */ /* User-deallocate; pointer is NULLified. */
extern void deallocate (void **, GFC_INTEGER_4 *); extern void deallocate (void *, GFC_INTEGER_4 *);
export_proto(deallocate); export_proto(deallocate);
void void
deallocate (void **mem, GFC_INTEGER_4 * stat) deallocate (void *mem, GFC_INTEGER_4 * stat)
{ {
if (!mem) if (!mem)
runtime_error ("Internal: NULL mem pointer in DEALLOCATE.");
if (!*mem)
{ {
if (stat) if (stat)
{ {
...@@ -308,15 +285,10 @@ deallocate (void **mem, GFC_INTEGER_4 * stat) ...@@ -308,15 +285,10 @@ deallocate (void **mem, GFC_INTEGER_4 * stat)
return; return;
} }
else else
{ runtime_error ("Internal: Attempt to DEALLOCATE unallocated memory.");
runtime_error
("Internal: Attempt to DEALLOCATE unallocated memory.");
abort ();
}
} }
free (*mem); free (mem);
*mem = NULL;
if (stat) if (stat)
*stat = 0; *stat = 0;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment