This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[PATCH][fortran] Rework allocator library interface


This reworks the libgfortran allocator interfaces to be suitable to
marking them with DECL_IS_MALLOC and so exposing the newly allocated
memory to better alias disambiguation.  This allows for example fatigue
to improve 30% with coalescing sin and cos to sincos which is not
possible at the moment due to aliasing issues solved by this patch.

This patch also bumps the libgfortran so version (we can omit this
change if we also apply the change to 4.2).

Bootstrapped and tested on x86_64-unknown-linux-gnu.

Ok for mainline?  (4.2?)

The ipa-reference.c chunk I'll commit separately.

Thanks,
Richard.

2006-12-11  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 *).
	* libtool-version: Bump shared library version.

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

Index: libgfortran/runtime/memory.c
===================================================================
*** libgfortran/runtime/memory.c	(revision 119733)
--- libgfortran/runtime/memory.c	(working copy)
*************** internal_realloc64 (void *mem, GFC_INTEG
*** 174,306 ****
  /* 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)
  {
    void *newmem;
  
-   if (!mem)
-     runtime_error ("Internal: NULL mem pointer in ALLOCATE.");
- 
    newmem = malloc (size ? size : 1);
    if (!newmem)
      {
        if (stat)
  	{
  	  *stat = 1;
! 	  return;
  	}
        else
  	runtime_error ("ALLOCATE: Out of memory.");
      }
  
-   (*mem) = newmem;
- 
    if (stat)
      *stat = 0;
  }
  
! extern void allocate (void **, GFC_INTEGER_4, GFC_INTEGER_4 *);
  export_proto(allocate);
  
! void
! allocate (void **mem, GFC_INTEGER_4 size, GFC_INTEGER_4 * stat)
  {
    if (size < 0)
!     {
!       runtime_error ("Attempt to allocate negative amount of memory.  "
! 		     "Possible integer overflow");
!       abort ();
!     }
  
!   allocate_size (mem, (size_t) size, stat);
  }
  
! extern void allocate64 (void **, GFC_INTEGER_8, GFC_INTEGER_4 *);
  export_proto(allocate64);
  
! void
! allocate64 (void **mem, 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 ();
!     }
  
!   allocate_size (mem, (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 *);
  export_proto(allocate_array);
  
! void
! allocate_array (void **mem, GFC_INTEGER_4 size, GFC_INTEGER_4 * stat)
  {
!   if (*mem == NULL)
!     {
!       allocate (mem, size, stat);
!       return;
!     }
    if (stat)
      {
!       free (*mem);
!       allocate (mem, size, stat);
        *stat = ERROR_ALLOCATION;
!       return;
      }
-   else
-     runtime_error ("Attempting to allocate already allocated array.");
  
!   return;
  }
  
  /* 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 *);
  export_proto(allocate64_array);
  
! void
! allocate64_array (void **mem, GFC_INTEGER_8 size, GFC_INTEGER_4 * stat)
  {
!   if (*mem == NULL)
!     {
!       allocate64 (mem, size, stat);
!       return;
!     }
    if (stat)
      {
!       free (*mem);
!       allocate (mem, size, stat);
        *stat = ERROR_ALLOCATION;
!       return;
      }
-   else
-     runtime_error ("Attempting to allocate already allocated array.");
  
!   return;
  }
  
  /* User-deallocate; pointer is NULLified. */
  
! extern void deallocate (void **, GFC_INTEGER_4 *);
  export_proto(deallocate);
  
  void
! deallocate (void **mem, GFC_INTEGER_4 * stat)
  {
    if (!mem)
-     runtime_error ("Internal: NULL mem pointer in DEALLOCATE.");
- 
-   if (!*mem)
      {
        if (stat)
  	{
--- 174,283 ----
  /* User-allocate, one call for each member of the alloc-list of an
     ALLOCATE statement. */
  
! static void *
! allocate_size (size_t size, GFC_INTEGER_4 * stat)
  {
    void *newmem;
  
    newmem = malloc (size ? size : 1);
    if (!newmem)
      {
        if (stat)
  	{
  	  *stat = 1;
! 	  return newmem;
  	}
        else
  	runtime_error ("ALLOCATE: Out of memory.");
      }
  
    if (stat)
      *stat = 0;
+ 
+   return newmem;
  }
  
! extern void *allocate (GFC_INTEGER_4, GFC_INTEGER_4 *);
  export_proto(allocate);
  
! 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");
  
!   return allocate_size ((size_t) size, stat);
  }
  
! extern void *allocate64 (GFC_INTEGER_8, GFC_INTEGER_4 *);
  export_proto(allocate64);
  
! 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");
  
!   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 *);
  export_proto(allocate_array);
  
! void *
! allocate_array (void *mem, GFC_INTEGER_4 size, GFC_INTEGER_4 * stat)
  {
!   if (mem == NULL)
!     return allocate (size, stat);
    if (stat)
      {
!       free (mem);
!       mem = allocate (size, stat);
        *stat = ERROR_ALLOCATION;
!       return mem;
      }
  
!   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 *);
  export_proto(allocate64_array);
  
! void *
! allocate64_array (void *mem, GFC_INTEGER_8 size, GFC_INTEGER_4 * stat)
  {
!   if (mem == NULL)
!     return allocate64 (size, stat);
    if (stat)
      {
!       free (mem);
!       mem = allocate (size, stat);
        *stat = ERROR_ALLOCATION;
!       return mem;
      }
  
!   runtime_error ("Attempting to allocate already allocated array.");
  }
  
  /* User-deallocate; pointer is NULLified. */
  
! extern void deallocate (void *, GFC_INTEGER_4 *);
  export_proto(deallocate);
  
  void
! deallocate (void *mem, GFC_INTEGER_4 * stat)
  {
    if (!mem)
      {
        if (stat)
  	{
*************** deallocate (void **mem, GFC_INTEGER_4 * 
*** 308,322 ****
  	  return;
  	}
        else
! 	{
! 	  runtime_error
! 	    ("Internal: Attempt to DEALLOCATE unallocated memory.");
! 	  abort ();
! 	}
      }
  
!   free (*mem);
!   *mem = NULL;
  
    if (stat)
      *stat = 0;
--- 285,294 ----
  	  return;
  	}
        else
! 	runtime_error ("Internal: Attempt to DEALLOCATE unallocated memory.");
      }
  
!   free (mem);
  
    if (stat)
      *stat = 0;
Index: libgfortran/libtool-version
===================================================================
*** libgfortran/libtool-version	(revision 119733)
--- libgfortran/libtool-version	(working copy)
***************
*** 3,6 ****
  # This is a separate file so that version updates don't involve re-running
  # automake.
  # CURRENT:REVISION:AGE
! 2:0:0
--- 3,6 ----
  # This is a separate file so that version updates don't involve re-running
  # automake.
  # CURRENT:REVISION:AGE
! 3:0:0
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c	(revision 119733)
--- gcc/fortran/trans-array.c	(working copy)
*************** gfc_array_allocate (gfc_se * se, gfc_exp
*** 3355,3362 ****
  			      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);
  
    if (TYPE_PRECISION (gfc_array_index_type) == 32)
      {
--- 3355,3362 ----
  			      lower, upper, &se->pre);
  
    /* Allocate memory to store the data.  */
!   pointer = gfc_conv_descriptor_data_get (se->expr);
!   STRIP_NOPS (pointer);
  
    if (TYPE_PRECISION (gfc_array_index_type) == 32)
      {
*************** gfc_array_allocate (gfc_se * se, gfc_exp
*** 3375,3384 ****
    else
      gcc_unreachable ();
  
!   tmp = gfc_chainon_list (NULL_TREE, pointer);
    tmp = gfc_chainon_list (tmp, size);
    tmp = gfc_chainon_list (tmp, pstat);
    tmp = build_function_call_expr (allocate, tmp);
    gfc_add_expr_to_block (&se->pre, tmp);
  
    tmp = gfc_conv_descriptor_offset (se->expr);
--- 3375,3388 ----
    else
      gcc_unreachable ();
  
!   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);
*************** gfc_array_deallocate (tree descriptor, t
*** 3409,3416 ****
  
    gfc_start_block (&block);
    /* Get a pointer to the data.  */
!   tmp = gfc_conv_descriptor_data_addr (descriptor);
!   var = gfc_evaluate_now (tmp, &block);
  
    /* Parameter is the address of the data component.  */
    tmp = gfc_chainon_list (NULL_TREE, var);
--- 3413,3420 ----
  
    gfc_start_block (&block);
    /* Get a pointer to the data.  */
!   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);
*************** gfc_array_deallocate (tree descriptor, t
*** 3418,3423 ****
--- 3422,3432 ----
    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);
  }
  
*************** gfc_trans_dealloc_allocated (tree descri
*** 4690,4697 ****
  
    gfc_start_block (&block);
  
!   tmp = gfc_conv_descriptor_data_addr (descriptor);
!   var = gfc_evaluate_now (tmp, &block);
    tmp = gfc_create_var (gfc_array_index_type, NULL);
    ptr = build_fold_addr_expr (tmp);
  
--- 4699,4706 ----
  
    gfc_start_block (&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);
  
*************** gfc_trans_dealloc_allocated (tree descri
*** 4702,4707 ****
--- 4711,4722 ----
    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: gcc/fortran/trans-stmt.c
===================================================================
*** gcc/fortran/trans-stmt.c	(revision 119733)
--- gcc/fortran/trans-stmt.c	(working copy)
*************** gfc_trans_allocate (gfc_code * code)
*** 3571,3591 ****
        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 (parm, pstat);
  	  tmp = build_function_call_expr (gfor_fndecl_allocate, parm);
  	  gfc_add_expr_to_block (&se.pre, tmp);
  
  	  if (code->expr)
--- 3571,3585 ----
        if (!gfc_array_allocate (&se, expr, pstat))
  	{
  	  /* A scalar or derived type.  */
  	  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, 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)
*************** gfc_trans_deallocate (gfc_code * code)
*** 3650,3656 ****
    gfc_se se;
    gfc_alloc *al;
    gfc_expr *expr;
!   tree apstat, astat, parm, pstat, stat, tmp, type, var;
    stmtblock_t block;
  
    gfc_start_block (&block);
--- 3644,3650 ----
    gfc_se se;
    gfc_alloc *al;
    gfc_expr *expr;
!   tree apstat, astat, parm, pstat, stat, tmp;
    stmtblock_t block;
  
    gfc_start_block (&block);
*************** gfc_trans_deallocate (gfc_code * code)
*** 3713,3726 ****
  	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 (parm, pstat);
  	  tmp = build_function_call_expr (gfor_fndecl_deallocate, parm);
  	}
  
        gfc_add_expr_to_block (&se.pre, tmp);
--- 3707,3719 ----
  	tmp = gfc_array_deallocate (se.expr, pstat);
        else
  	{
! 	  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: gcc/fortran/trans-decl.c
===================================================================
*** gcc/fortran/trans-decl.c	(revision 119733)
--- gcc/fortran/trans-decl.c	(working copy)
*************** gfc_build_builtin_function_decls (void)
*** 2304,2330 ****
  
    gfor_fndecl_allocate =
      gfc_build_library_function_decl (get_identifier (PREFIX("allocate")),
! 				     void_type_node, 2, ppvoid_type_node,
! 				     gfc_int4_type_node);
  
    gfor_fndecl_allocate64 =
      gfc_build_library_function_decl (get_identifier (PREFIX("allocate64")),
! 				     void_type_node, 2, ppvoid_type_node,
! 				     gfc_int8_type_node);
  
    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);
  
    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);
  
    gfor_fndecl_deallocate =
      gfc_build_library_function_decl (get_identifier (PREFIX("deallocate")),
! 				     void_type_node, 2, ppvoid_type_node,
  				     gfc_pint4_type_node);
  
    gfor_fndecl_stop_numeric =
--- 2304,2334 ----
  
    gfor_fndecl_allocate =
      gfc_build_library_function_decl (get_identifier (PREFIX("allocate")),
! 				     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")),
! 				     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")),
! 				     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")),
! 				     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, pvoid_type_node,
  				     gfc_pint4_type_node);
  
    gfor_fndecl_stop_numeric =
Index: gcc/ipa-reference.c
===================================================================
*** gcc/ipa-reference.c	(revision 119733)
--- gcc/ipa-reference.c	(working copy)
*************** scan_for_static_refs (tree *tp, 
*** 507,512 ****
--- 507,513 ----
  	switch (TREE_CODE_CLASS (TREE_CODE (rhs))) 
  	  {
  	  case tcc_binary:	    
+ 	  case tcc_comparison:	    
   	    {
   	      tree op0 = TREE_OPERAND (rhs, 0);
   	      tree op1 = TREE_OPERAND (rhs, 1);


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]