aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog28
-rw-r--r--gcc/fortran/f95-lang.c11
-rw-r--r--gcc/fortran/trans-array.c38
-rw-r--r--gcc/fortran/trans-decl.c26
-rw-r--r--gcc/fortran/trans-expr.c6
-rw-r--r--gcc/fortran/trans-intrinsic.c11
-rw-r--r--gcc/fortran/trans-stmt.c19
-rw-r--r--gcc/fortran/trans.c81
-rw-r--r--gcc/fortran/trans.h10
-rw-r--r--libgfortran/ChangeLog15
-rw-r--r--libgfortran/gfortran.map4
-rw-r--r--libgfortran/intrinsics/move_alloc.c14
-rw-r--r--libgfortran/libgfortran.h5
-rw-r--r--libgfortran/runtime/error.c1
-rw-r--r--libgfortran/runtime/memory.c40
15 files changed, 184 insertions, 125 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 87947c2..625e304 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,33 @@
2007-05-14 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+ PR fortran/30723
+ * trans.h (gfor_fndecl_internal_malloc, gfor_fndecl_internal_malloc64,
+ gfor_fndecl_internal_free): Remove prototypes.
+ (gfor_fndecl_os_error, gfc_call_free, gfc_call_malloc): Add prototypes.
+ * trans.c (gfc_call_malloc, gfc_call_free): New functions.
+ * f95-lang.c (gfc_init_builtin_functions): Add __builtin_free
+ and __builtin_malloc builtins.
+ * trans-decl.c (gfor_fndecl_internal_malloc,
+ gfor_fndecl_internal_malloc64, gfor_fndecl_internal_free): Remove.
+ (gfor_fndecl_os_error): Add.
+ (gfc_build_builtin_function_decls): Don't create internal_malloc,
+ internal_malloc64 and internal_free library function declaration.
+ Create os_error library call function declaration.
+ * trans-array.c (gfc_trans_allocate_array_storage,
+ gfc_trans_auto_array_allocation, gfc_trans_dummy_array_bias,
+ gfc_conv_array_parameter, gfc_duplicate_allocatable): Use
+ gfc_call_malloc and gfc_call_free instead of building calls to
+ internal_malloc and internal_free.
+ * trans-expr.c (gfc_conv_string_tmp): Likewise.
+ * trans-stmt.c (gfc_do_allocate, gfc_trans_assign_need_temp,
+ gfc_trans_pointer_assign_need_temp, gfc_trans_forall_1,
+ gfc_trans_where_2: Likewise.
+ * trans-intrinsic.c (gfc_conv_intrinsic_ctime,
+ gfc_conv_intrinsic_fdate, gfc_conv_intrinsic_ttynam,
+ gfc_conv_intrinsic_array_transfer, gfc_conv_intrinsic_trim): Likewise.
+
+2007-05-14 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
PR fortran/31725
* trans-expr.c (gfc_conv_substring): Evaluate substring bounds
only once.
diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index d4fc2cc..06cea98 100644
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -988,6 +988,17 @@ gfc_init_builtin_functions (void)
gfc_define_builtin ("__builtin_expect", ftype, BUILT_IN_EXPECT,
"__builtin_expect", true);
+ tmp = tree_cons (NULL_TREE, pvoid_type_node, void_list_node);
+ ftype = build_function_type (void_type_node, tmp);
+ gfc_define_builtin ("__builtin_free", ftype, BUILT_IN_FREE,
+ "free", false);
+
+ tmp = tree_cons (NULL_TREE, size_type_node, void_list_node);
+ ftype = build_function_type (pvoid_type_node, tmp);
+ gfc_define_builtin ("__builtin_malloc", ftype, BUILT_IN_MALLOC,
+ "malloc", false);
+ DECL_IS_MALLOC (built_in_decls[BUILT_IN_MALLOC]) = 1;
+
#define DEF_PRIMITIVE_TYPE(ENUM, VALUE) \
builtin_types[(int) ENUM] = VALUE;
#define DEF_FUNCTION_TYPE_0(ENUM, RETURN) \
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 4997673..61e3554 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -533,13 +533,7 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post,
else
{
/* Allocate memory to hold the data. */
- if (gfc_index_integer_kind == 4)
- tmp = gfor_fndecl_internal_malloc;
- else if (gfc_index_integer_kind == 8)
- tmp = gfor_fndecl_internal_malloc64;
- else
- gcc_unreachable ();
- tmp = build_call_expr (tmp, 1, size);
+ tmp = gfc_call_malloc (pre, NULL, size);
tmp = gfc_evaluate_now (tmp, pre);
gfc_conv_descriptor_data_set (pre, desc, tmp);
}
@@ -555,8 +549,7 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post,
{
/* Free the temporary. */
tmp = gfc_conv_descriptor_data_get (desc);
- tmp = fold_convert (pvoid_type_node, tmp);
- tmp = build_call_expr (gfor_fndecl_internal_free, 1, tmp);
+ tmp = gfc_call_free (fold_convert (pvoid_type_node, tmp));
gfc_add_expr_to_block (post, tmp);
}
}
@@ -3793,7 +3786,6 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, tree fnbody)
stmtblock_t block;
tree type;
tree tmp;
- tree fndecl;
tree size;
tree offset;
bool onstack;
@@ -3857,14 +3849,7 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, tree fnbody)
size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, tmp);
/* Allocate memory to hold the data. */
- if (gfc_index_integer_kind == 4)
- fndecl = gfor_fndecl_internal_malloc;
- else if (gfc_index_integer_kind == 8)
- fndecl = gfor_fndecl_internal_malloc64;
- else
- gcc_unreachable ();
- tmp = build_call_expr (fndecl, 1, size);
- tmp = fold_convert (TREE_TYPE (decl), tmp);
+ tmp = gfc_call_malloc (&block, TREE_TYPE (decl), size);
gfc_add_modify_expr (&block, decl, tmp);
/* Set offset of the array. */
@@ -3878,8 +3863,7 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, tree fnbody)
gfc_add_expr_to_block (&block, fnbody);
/* Free the temporary. */
- tmp = convert (pvoid_type_node, decl);
- tmp = build_call_expr (gfor_fndecl_internal_free, 1, tmp);
+ tmp = gfc_call_free (convert (pvoid_type_node, decl));
gfc_add_expr_to_block (&block, tmp);
return gfc_finish_block (&block);
@@ -4235,7 +4219,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
}
/* Free the temporary. */
- tmp = build_call_expr (gfor_fndecl_internal_free, 1, tmpdesc);
+ tmp = gfc_call_free (tmpdesc);
gfc_add_expr_to_block (&cleanup, tmp);
stmt = gfc_finish_block (&cleanup);
@@ -4841,8 +4825,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77)
gfc_add_expr_to_block (&block, tmp);
/* Free the temporary. */
- tmp = convert (pvoid_type_node, ptr);
- tmp = build_call_expr (gfor_fndecl_internal_free, 1, tmp);
+ tmp = gfc_call_free (convert (pvoid_type_node, ptr));
gfc_add_expr_to_block (&block, tmp);
stmt = gfc_finish_block (&block);
@@ -4942,13 +4925,8 @@ gfc_duplicate_allocatable(tree dest, tree src, tree type, int rank)
TYPE_SIZE_UNIT (gfc_get_element_type (type)));
/* Allocate memory to the destination. */
- if (gfc_index_integer_kind == 4)
- tmp = build_call_expr (gfor_fndecl_internal_malloc, 1, size);
- else if (gfc_index_integer_kind == 8)
- tmp = build_call_expr (gfor_fndecl_internal_malloc64, 1, size);
- else
- gcc_unreachable ();
- tmp = fold_convert (TREE_TYPE (gfc_conv_descriptor_data_get (src)), tmp);
+ tmp = gfc_call_malloc (&block, TREE_TYPE (gfc_conv_descriptor_data_get (src)),
+ size);
gfc_conv_descriptor_data_set (&block, dest, tmp);
/* We know the temporary and the value will be the same length,
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 835e515..8c564cb 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -74,11 +74,8 @@ tree gfc_static_ctors;
/* Function declarations for builtin library functions. */
-tree gfor_fndecl_internal_malloc;
-tree gfor_fndecl_internal_malloc64;
tree gfor_fndecl_internal_realloc;
tree gfor_fndecl_internal_realloc64;
-tree gfor_fndecl_internal_free;
tree gfor_fndecl_allocate;
tree gfor_fndecl_allocate64;
tree gfor_fndecl_allocate_array;
@@ -91,6 +88,7 @@ tree gfor_fndecl_stop_string;
tree gfor_fndecl_select_string;
tree gfor_fndecl_runtime_error;
tree gfor_fndecl_runtime_error_at;
+tree gfor_fndecl_os_error;
tree gfor_fndecl_generate_error;
tree gfor_fndecl_set_fpe;
tree gfor_fndecl_set_std;
@@ -2247,18 +2245,6 @@ gfc_build_builtin_function_decls (void)
tree gfc_logical4_type_node = gfc_get_logical_type (4);
tree gfc_pint4_type_node = build_pointer_type (gfc_int4_type_node);
- /* Treat these two internal malloc wrappers as malloc. */
- gfor_fndecl_internal_malloc =
- gfc_build_library_function_decl (get_identifier (PREFIX("internal_malloc")),
- pvoid_type_node, 1, gfc_int4_type_node);
- DECL_IS_MALLOC (gfor_fndecl_internal_malloc) = 1;
-
- gfor_fndecl_internal_malloc64 =
- gfc_build_library_function_decl (get_identifier
- (PREFIX("internal_malloc64")),
- pvoid_type_node, 1, gfc_int8_type_node);
- DECL_IS_MALLOC (gfor_fndecl_internal_malloc64) = 1;
-
gfor_fndecl_internal_realloc =
gfc_build_library_function_decl (get_identifier
(PREFIX("internal_realloc")),
@@ -2271,10 +2257,6 @@ gfc_build_builtin_function_decls (void)
pvoid_type_node, 2, pvoid_type_node,
gfc_int8_type_node);
- gfor_fndecl_internal_free =
- gfc_build_library_function_decl (get_identifier (PREFIX("internal_free")),
- void_type_node, 1, pvoid_type_node);
-
gfor_fndecl_allocate =
gfc_build_library_function_decl (get_identifier (PREFIX("allocate")),
pvoid_type_node, 2,
@@ -2349,6 +2331,12 @@ gfc_build_builtin_function_decls (void)
void_type_node, 3, pvoid_type_node,
gfc_c_int_type_node, pchar_type_node);
+ gfor_fndecl_os_error =
+ gfc_build_library_function_decl (get_identifier (PREFIX("os_error")),
+ void_type_node, 1, pchar_type_node);
+ /* The runtime_error function does not return. */
+ TREE_THIS_VOLATILE (gfor_fndecl_os_error) = 1;
+
gfor_fndecl_set_fpe =
gfc_build_library_function_decl (get_identifier (PREFIX("set_fpe")),
void_type_node, 1, gfc_c_int_type_node);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 34be30c..d5f584c 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -935,13 +935,11 @@ gfc_conv_string_tmp (gfc_se * se, tree type, tree len)
{
/* Allocate a temporary to hold the result. */
var = gfc_create_var (type, "pstr");
- tmp = build_call_expr (gfor_fndecl_internal_malloc, 1, len);
- tmp = convert (type, tmp);
+ tmp = gfc_call_malloc (&se->pre, type, len);
gfc_add_modify_expr (&se->pre, var, tmp);
/* Free the temporary afterwards. */
- tmp = convert (pvoid_type_node, var);
- tmp = build_call_expr (gfor_fndecl_internal_free, 1, tmp);
+ tmp = gfc_call_free (convert (pvoid_type_node, var));
gfc_add_expr_to_block (&se->post, tmp);
}
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 33b2e22..75b5a4c 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1275,7 +1275,7 @@ gfc_conv_intrinsic_ctime (gfc_se * se, gfc_expr * expr)
/* Free the temporary afterwards, if necessary. */
cond = build2 (GT_EXPR, boolean_type_node, len,
build_int_cst (TREE_TYPE (len), 0));
- tmp = build_call_expr (gfor_fndecl_internal_free, 1, var);
+ tmp = gfc_call_free (var);
tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
gfc_add_expr_to_block (&se->post, tmp);
@@ -1310,7 +1310,7 @@ gfc_conv_intrinsic_fdate (gfc_se * se, gfc_expr * expr)
/* Free the temporary afterwards, if necessary. */
cond = build2 (GT_EXPR, boolean_type_node, len,
build_int_cst (TREE_TYPE (len), 0));
- tmp = build_call_expr (gfor_fndecl_internal_free, 1, var);
+ tmp = gfc_call_free (var);
tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
gfc_add_expr_to_block (&se->post, tmp);
@@ -1347,7 +1347,7 @@ gfc_conv_intrinsic_ttynam (gfc_se * se, gfc_expr * expr)
/* Free the temporary afterwards, if necessary. */
cond = build2 (GT_EXPR, boolean_type_node, len,
build_int_cst (TREE_TYPE (len), 0));
- tmp = build_call_expr (gfor_fndecl_internal_free, 1, var);
+ tmp = gfc_call_free (var);
tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
gfc_add_expr_to_block (&se->post, tmp);
@@ -2866,8 +2866,7 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
/* Free the temporary. */
gfc_start_block (&block);
- tmp = convert (pvoid_type_node, source);
- tmp = build_call_expr (gfor_fndecl_internal_free, 1, tmp);
+ tmp = gfc_call_free (convert (pvoid_type_node, source));
gfc_add_expr_to_block (&block, tmp);
stmt = gfc_finish_block (&block);
@@ -3364,7 +3363,7 @@ gfc_conv_intrinsic_trim (gfc_se * se, gfc_expr * expr)
/* Free the temporary afterwards, if necessary. */
cond = build2 (GT_EXPR, boolean_type_node, len,
build_int_cst (TREE_TYPE (len), 0));
- tmp = build_call_expr (gfor_fndecl_internal_free, 1, var);
+ tmp = gfc_call_free (var);
tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
gfc_add_expr_to_block (&se->post, tmp);
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 0fcc66f..d0af66e 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -1712,14 +1712,7 @@ gfc_do_allocate (tree bytesize, tree size, tree * pdata, stmtblock_t * pblock,
tmpvar = gfc_create_var (build_pointer_type (type), "temp");
*pdata = convert (pvoid_type_node, tmpvar);
- if (gfc_index_integer_kind == 4)
- tmp = gfor_fndecl_internal_malloc;
- else if (gfc_index_integer_kind == 8)
- tmp = gfor_fndecl_internal_malloc64;
- else
- gcc_unreachable ();
- tmp = build_call_expr (tmp, 1, bytesize);
- tmp = convert (TREE_TYPE (tmpvar), tmp);
+ tmp = gfc_call_malloc (pblock, TREE_TYPE (tmpvar), bytesize);
gfc_add_modify_expr (pblock, tmpvar, tmp);
}
return tmpvar;
@@ -2230,7 +2223,7 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
if (ptemp1)
{
/* Free the temporary. */
- tmp = build_call_expr (gfor_fndecl_internal_free, 1, ptemp1);
+ tmp = gfc_call_free (ptemp1);
gfc_add_expr_to_block (block, tmp);
}
}
@@ -2388,7 +2381,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
/* Free the temporary. */
if (ptemp1)
{
- tmp = build_call_expr (gfor_fndecl_internal_free, 1, ptemp1);
+ tmp = gfc_call_free (ptemp1);
gfc_add_expr_to_block (block, tmp);
}
}
@@ -2723,7 +2716,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
if (pmask)
{
/* Free the temporary for the mask. */
- tmp = build_call_expr (gfor_fndecl_internal_free, 1, pmask);
+ tmp = gfc_call_free (pmask);
gfc_add_expr_to_block (&block, tmp);
}
if (maskindex)
@@ -3320,14 +3313,14 @@ gfc_trans_where_2 (gfc_code * code, tree mask, bool invert,
/* If we allocated a pending mask array, deallocate it now. */
if (ppmask)
{
- tmp = build_call_expr (gfor_fndecl_internal_free, 1, ppmask);
+ tmp = gfc_call_free (ppmask);
gfc_add_expr_to_block (block, tmp);
}
/* If we allocated a current mask array, deallocate it now. */
if (pcmask)
{
- tmp = build_call_expr (gfor_fndecl_internal_free, 1, pcmask);
+ tmp = gfc_call_free (pcmask);
gfc_add_expr_to_block (block, tmp);
}
}
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 5e717e4..97336b6 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -29,6 +29,7 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
#include "toplev.h"
#include "defaults.h"
#include "real.h"
+#include "flags.h"
#include "gfortran.h"
#include "trans.h"
#include "trans-stmt.h"
@@ -372,6 +373,86 @@ gfc_trans_runtime_check (tree cond, const char * msgid, stmtblock_t * pblock,
}
+/* Call malloc to allocate size bytes of memory, with special conditions:
+ + if size < 0, generate a runtime error,
+ + if size == 0, return a NULL pointer,
+ + if malloc returns NULL, issue a runtime error. */
+tree
+gfc_call_malloc (stmtblock_t * block, tree type, tree size)
+{
+ tree tmp, msg, negative, zero, malloc_result, null_result, res;
+ stmtblock_t block2;
+
+ 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 (pvoid_type_node, NULL);
+
+ /* size < 0 ? */
+ negative = fold_build2 (LT_EXPR, boolean_type_node, size,
+ build_int_cst (size_type_node, 0));
+ msg = gfc_build_addr_expr (pchar_type_node, gfc_build_cstring_const
+ ("Attempt to allocate a negative amount of memory."));
+ tmp = fold_build3 (COND_EXPR, void_type_node, negative,
+ build_call_expr (gfor_fndecl_runtime_error, 1, msg),
+ build_empty_stmt ());
+ gfc_add_expr_to_block (block, tmp);
+
+ /* Call malloc and check the result. */
+ gfc_start_block (&block2);
+ gfc_add_modify_expr (&block2, res,
+ build_call_expr (built_in_decls[BUILT_IN_MALLOC], 1,
+ size));
+ null_result = fold_build2 (EQ_EXPR, boolean_type_node, res,
+ build_int_cst (pvoid_type_node, 0));
+ msg = gfc_build_addr_expr (pchar_type_node, gfc_build_cstring_const
+ ("Memory allocation failed"));
+ tmp = fold_build3 (COND_EXPR, void_type_node, null_result,
+ build_call_expr (gfor_fndecl_os_error, 1, msg),
+ build_empty_stmt ());
+ gfc_add_expr_to_block (&block2, tmp);
+ malloc_result = gfc_finish_block (&block2);
+
+ /* size == 0 */
+ zero = fold_build2 (EQ_EXPR, boolean_type_node, size,
+ build_int_cst (size_type_node, 0));
+ tmp = fold_build2 (MODIFY_EXPR, pvoid_type_node, res,
+ build_int_cst (pvoid_type_node, 0));
+ tmp = fold_build3 (COND_EXPR, void_type_node, zero, tmp, malloc_result);
+ gfc_add_expr_to_block (block, tmp);
+
+ if (type != NULL)
+ res = fold_convert (type, res);
+ return res;
+}
+
+
+/* Free a given variable, if it's not NULL. */
+tree
+gfc_call_free (tree var)
+{
+ stmtblock_t block;
+ tree tmp, cond, call;
+
+ if (TREE_TYPE (var) != TREE_TYPE (pvoid_type_node))
+ var = fold_convert (pvoid_type_node, var);
+
+ gfc_start_block (&block);
+ var = gfc_evaluate_now (var, &block);
+ cond = fold_build2 (NE_EXPR, boolean_type_node, var,
+ build_int_cst (pvoid_type_node, 0));
+ call = build_call_expr (built_in_decls[BUILT_IN_FREE], 1, var);
+ tmp = fold_build3 (COND_EXPR, void_type_node, cond, call,
+ build_empty_stmt ());
+ gfc_add_expr_to_block (&block, tmp);
+
+ return gfc_finish_block (&block);
+}
+
+
/* Add a statement to a block. */
void
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 731045a..da4b0c1 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -439,6 +439,12 @@ bool get_array_ctor_strlen (gfc_constructor *, tree *);
/* Generate a runtime error check. */
void gfc_trans_runtime_check (tree, const char *, stmtblock_t *, locus *);
+/* Generate a call to free() after checking that its arg is non-NULL. */
+tree gfc_call_free (tree);
+
+/* Allocate memory after performing a few checks. */
+tree gfc_call_malloc (stmtblock_t *, tree, tree);
+
/* Generate code for an assignment, includes scalarization. */
tree gfc_trans_assignment (gfc_expr *, gfc_expr *, bool);
@@ -472,11 +478,8 @@ struct gimplify_omp_ctx;
void gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *, tree);
/* Runtime library function decls. */
-extern GTY(()) tree gfor_fndecl_internal_malloc;
-extern GTY(()) tree gfor_fndecl_internal_malloc64;
extern GTY(()) tree gfor_fndecl_internal_realloc;
extern GTY(()) tree gfor_fndecl_internal_realloc64;
-extern GTY(()) tree gfor_fndecl_internal_free;
extern GTY(()) tree gfor_fndecl_allocate;
extern GTY(()) tree gfor_fndecl_allocate64;
extern GTY(()) tree gfor_fndecl_allocate_array;
@@ -489,6 +492,7 @@ extern GTY(()) tree gfor_fndecl_stop_string;
extern GTY(()) tree gfor_fndecl_select_string;
extern GTY(()) tree gfor_fndecl_runtime_error;
extern GTY(()) tree gfor_fndecl_runtime_error_at;
+extern GTY(()) tree gfor_fndecl_os_error;
extern GTY(()) tree gfor_fndecl_generate_error;
extern GTY(()) tree gfor_fndecl_set_fpe;
extern GTY(()) tree gfor_fndecl_set_std;
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index acfaec5..a90c716 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,18 @@
+2007-05-14 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+ PR fortran/30723
+ * runtime/memory.c (internal_malloc, internal_malloc64,
+ internal_free): Remove.
+ * runtime/error.c (os_error): Export function.
+ * intrinsics/move_alloc.c: Include stdlib.h.
+ (move_alloc): Call free instead of internal_free.
+ (move_alloc_c): Wrap long lines.
+ * libgfortran.h (os_error): Export prototype.
+ (internal_free): Remove prototype.
+ * gfortran.map (GFORTRAN_1.0): Remove _gfortran_internal_free,
+ _gfortran_internal_malloc and _gfortran_internal_malloc64.
+ Add _gfortran_os_error.
+
2007-05-09 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/31880
diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map
index c1ca725..f67192d 100644
--- a/libgfortran/gfortran.map
+++ b/libgfortran/gfortran.map
@@ -166,9 +166,6 @@ GFORTRAN_1.0 {
_gfortran_idate_i8;
_gfortran_ierrno_i4;
_gfortran_ierrno_i8;
- _gfortran_internal_free;
- _gfortran_internal_malloc;
- _gfortran_internal_malloc64;
_gfortran_internal_pack;
_gfortran_internal_realloc;
_gfortran_internal_realloc64;
@@ -502,6 +499,7 @@ GFORTRAN_1.0 {
_gfortran_nearest_r16;
_gfortran_nearest_r4;
_gfortran_nearest_r8;
+ _gfortran_os_error;
_gfortran_pack;
_gfortran_pack_char;
_gfortran_pack_s;
diff --git a/libgfortran/intrinsics/move_alloc.c b/libgfortran/intrinsics/move_alloc.c
index b73ef4b..24baf39 100644
--- a/libgfortran/intrinsics/move_alloc.c
+++ b/libgfortran/intrinsics/move_alloc.c
@@ -28,8 +28,13 @@ License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
+#include "config.h"
#include "libgfortran.h"
+#ifdef HAVE_STDLIB_H
+#include <stdlib.h>
+#endif
+
extern void move_alloc (gfc_array_char *, gfc_array_char *);
export_proto(move_alloc);
@@ -38,7 +43,8 @@ move_alloc (gfc_array_char * from, gfc_array_char * to)
{
int i;
- internal_free (to->data);
+ if (to->data)
+ free (to->data);
for (i = 0; i < GFC_DESCRIPTOR_RANK (from); i++)
{
@@ -60,8 +66,10 @@ extern void move_alloc_c (gfc_array_char *, GFC_INTEGER_4,
export_proto(move_alloc_c);
void
-move_alloc_c (gfc_array_char * from, GFC_INTEGER_4 from_length __attribute__((unused)),
- gfc_array_char * to, GFC_INTEGER_4 to_length __attribute__((unused)))
+move_alloc_c (gfc_array_char * from,
+ GFC_INTEGER_4 from_length __attribute__((unused)),
+ gfc_array_char * to,
+ GFC_INTEGER_4 to_length __attribute__((unused)))
{
move_alloc (from, to);
}
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 0f7d2c7..fd510ee 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -583,7 +583,7 @@ extern const char *xtoa (GFC_UINTEGER_LARGEST, char *, size_t);
internal_proto(xtoa);
extern void os_error (const char *) __attribute__ ((noreturn));
-internal_proto(os_error);
+iexport_proto(os_error);
extern void show_locus (st_parameter_common *);
internal_proto(show_locus);
@@ -634,9 +634,6 @@ internal_proto(free_mem);
extern void *internal_malloc_size (size_t);
internal_proto(internal_malloc_size);
-extern void internal_free (void *);
-iexport_proto(internal_free);
-
/* environ.c */
extern int check_buffered (int);
diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c
index 2bcc293..bd3c306 100644
--- a/libgfortran/runtime/error.c
+++ b/libgfortran/runtime/error.c
@@ -285,6 +285,7 @@ os_error (const char *message)
st_printf ("Operating system error: %s\n%s\n", get_oserror (), message);
sys_exit (1);
}
+iexport(os_error);
/* void runtime_error()-- These are errors associated with an
diff --git a/libgfortran/runtime/memory.c b/libgfortran/runtime/memory.c
index 5839530..fe76675 100644
--- a/libgfortran/runtime/memory.c
+++ b/libgfortran/runtime/memory.c
@@ -77,46 +77,6 @@ internal_malloc_size (size_t size)
return get_mem (size);
}
-extern void *internal_malloc (GFC_INTEGER_4);
-export_proto(internal_malloc);
-
-void *
-internal_malloc (GFC_INTEGER_4 size)
-{
-#ifdef GFC_CHECK_MEMORY
- /* Under normal circumstances, this is _never_ going to happen! */
- if (size < 0)
- runtime_error ("Attempt to allocate a negative amount of memory.");
-
-#endif
- return internal_malloc_size ((size_t) size);
-}
-
-extern void *internal_malloc64 (GFC_INTEGER_8);
-export_proto(internal_malloc64);
-
-void *
-internal_malloc64 (GFC_INTEGER_8 size)
-{
-#ifdef GFC_CHECK_MEMORY
- /* Under normal circumstances, this is _never_ going to happen! */
- if (size < 0)
- runtime_error ("Attempt to allocate a negative amount of memory.");
-#endif
- return internal_malloc_size ((size_t) size);
-}
-
-
-/* Free internally allocated memory. Pointer is NULLified. Also used to
- free user allocated memory. */
-
-void
-internal_free (void *mem)
-{
- if (mem != NULL)
- free (mem);
-}
-iexport(internal_free);
/* Reallocate internal memory MEM so it has SIZE bytes of data.
Allocate a new block if MEM is zero, and free the block if
generated by cgit v1.1 at 2024-08-26 20:00:40 +0000