OSDN Git Service

PR fortran/30723
authorfxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 14 May 2007 19:33:57 +0000 (19:33 +0000)
committerfxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 14 May 2007 19:33:57 +0000 (19:33 +0000)
* 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.

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

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@124721 138bc75d-0d04-0410-961f-82ee72b054a4

15 files changed:
gcc/fortran/ChangeLog
gcc/fortran/f95-lang.c
gcc/fortran/trans-array.c
gcc/fortran/trans-decl.c
gcc/fortran/trans-expr.c
gcc/fortran/trans-intrinsic.c
gcc/fortran/trans-stmt.c
gcc/fortran/trans.c
gcc/fortran/trans.h
libgfortran/ChangeLog
libgfortran/gfortran.map
libgfortran/intrinsics/move_alloc.c
libgfortran/libgfortran.h
libgfortran/runtime/error.c
libgfortran/runtime/memory.c

index 87947c2..625e304 100644 (file)
@@ -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.
index d4fc2cc..06cea98 100644 (file)
@@ -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)              \
index 4997673..61e3554 100644 (file)
@@ -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,
index 835e515..8c564cb 100644 (file)
@@ -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);
index 34be30c..d5f584c 100644 (file)
@@ -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);
     }
 
index 33b2e22..75b5a4c 100644 (file)
@@ -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);
 
index 0fcc66f..d0af66e 100644 (file)
@@ -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);
     }
 }
index 5e717e4..97336b6 100644 (file)
@@ -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
index 731045a..da4b0c1 100644 (file)
@@ -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;
index acfaec5..a90c716 100644 (file)
@@ -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
index c1ca725..f67192d 100644 (file)
@@ -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;
index b73ef4b..24baf39 100644 (file)
@@ -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);
 }
index 0f7d2c7..fd510ee 100644 (file)
@@ -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);
index 2bcc293..bd3c306 100644 (file)
@@ -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
index 5839530..fe76675 100644 (file)
@@ -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