OSDN Git Service

2006-12-13 Richard Guenther <rguenther@suse.de>
authorrguenth <rguenth@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 13 Dec 2006 09:57:56 +0000 (09:57 +0000)
committerrguenth <rguenth@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 13 Dec 2006 09:57:56 +0000 (09:57 +0000)
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.

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

gcc/fortran/ChangeLog
gcc/fortran/trans-array.c
gcc/fortran/trans-decl.c
gcc/fortran/trans-stmt.c
libgfortran/ChangeLog
libgfortran/runtime/memory.c

index eb9efa1..fdc054e 100644 (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\81├╝ter  <tobias.schlueter@physik.uni-muenchen.de>
 
        * trans-expr.c (gfc_conv_substring): Check for empty substring.
index bfd0600..b65ec74 100644 (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);
 }
 
index 67e654c..815b15e 100644 (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 =
index 03ff0fe..df853ec 100644 (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);
index 6d9739a..d80cf70 100644 (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
index 43a72e3..b38d062 100644 (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;