This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran 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]

Re: [Patch, fortran] Runtime memory leak checking.


Hi all,

I just updated the memleak patch to current trunk, since I
incidentally found some use for it lately and wanted to try it.

Up to now I basically just re-diffed it (repairing some failed hunks)
and fixed some indentation problems reported by Mikael, but maybe I'll
be working some more on this soon. Seems like the patch may be almost
ready to go into trunk, I guess?

Some comments by previous reviewers that still need to be addressed:

*******************************

* this one by Daniel Franke:

> > +      st_printf (" !! Memory leak in the code generated by the GNU Fortran
> > " +            "compiler.\n !! Please report this issue to "
> > +              "http://gcc.gnu.org/bugzilla/\n";;);
>
> There's a toplevel configuration option, '--with-bugurl'.
> Maybe the configured url should  be used instead of a hardcoded one?

*******************************

* this one by Tobias Burnus:

> What is "memusage" supposed to do?
>
> (I think you plan to add a patch for "memusage" soon; if not I'd prefer
> that remove the option.)

I would think that "memusage" should just output the memory usage
statistics that "memleaks" also prints:

Peak user-allocated memory: ...
Peak memory created by the compiler for temporaries: ...

but without the memleak analysis. Or maybe a more detailed memory
usage analysis like valgrind (massif) does? I think in any way this
may be useful as a separate feature and we should keep the option in.

*******************************

* another comment by Tobias:

> @@ -5453,8 +5469,9 @@
>                                    TYPE_SIZE_UNIT (gfc_get_element_type (type))));
>
>   /* Allocate memory to the destination.  */
> -  tmp = gfc_call_malloc (&block, TREE_TYPE (gfc_conv_descriptor_data_get (src)),
> -                        size);
> +  tmp = gfc_allocate_with_status (&block, size, NULL_TREE,
> +                                 &gfc_current_locus);
> +  tmp = fold_convert (TREE_TYPE (gfc_conv_descriptor_data_get (src)), tmp);
>   gfc_conv_descriptor_data_set (&block, dest, tmp);
>
>
> Is there a reason that you don't use
>  if (gfc_option.rtcheck & GFC_RTCHECK_MEMLEAKS)
> here, but that you have such an if in lines
> @@ -4179,7 +4186,12 @@

*******************************

* and this one:

> You need to update invoke.texi. Additionally, you need to add the new
> functions to  gfortran.map. After doing so, one can actually get rid of
> the -static.
>
> Is it really necessary to link libiberty even if no memleak checks are
> enabled?

Actually, where in gfortan.map do they have to be added? Should there
be a GFORTRAN_1.2 for 4.5?

*******************************

* Note also that the patch fails on the following test case (which is
perfectly legal):

implicit none
character(100), save :: path_To_Input='../test.dat'
logical :: ex
Inquire(file=trim(path_to_Input),exist=ex)
print *,ex
end

with the following message:

Error in memory deallocation at line 4 of source file 'test.f90':
freeing memory that has not been allocated by us.

*******************************

Cheers,
Janus





2008/11/29 Paul Richard Thomas <paul.richard.thomas@gmail.com>:
> This patch is almost entirely due to FX Coudert; I added the updating
> of gfc_current_locus in trans.c, the testcase and the ChangeLogs. ?I
> also corrected one error.
>
> The patch implements checking for memory leaks, such that:
>
> [prt@localhost mem-check]# cat m*.f90
> ! { dg-do run }
> ! { dg-options = "-fruntime-check=memleaks" }
> !
> ! Test the runtime check for memory leaks.
> !
> ?integer(4), pointer :: i(:)
> ?allocate (i(10))
> end
> ! { dg-output "found 1 memory leaks" }
>
> [prt@localhost mem-check]# /irun/bin/gfortran -static
> -fruntime-check=memleaks m*.f90;./a.out
>
>
> Fortran runtime checking: found 1 memory leaks
> ?- at line 7 of file 'mem_check_1.f90', allocation of 40.0 B (address
> 0x1749ee0)
>
> Peak user-allocated memory: 40.0 B
> Peak memory created by the compiler for temporaries: 0.00 B
>
> When applied to some of the allocatable component testcases, such as:
> [prt@localhost mem-check]# /irun/bin/gfortran -static
> -fruntime-check=memleaks
> /svn/trunk/gcc/testsuite/gfortran.dg/alloc_comp_basics_5.f90;./a.out
>
>
> Fortran runtime checking: found 1 memory leaks
> ?- at line 25 of file
> '/svn/trunk/gcc/testsuite/gfortran.dg/alloc_comp_basics_5.f90',
> allocation of 40.0 B (address 0x24fdee0)
>
> Peak user-allocated memory: 40.0 B
> Peak memory created by the compiler for temporaries: 0.00 B
>
> It also adds hooks for memusage and recursion in runtime.
>
> All the action happens in libgfortran/runtime/mem-check.c. ?This sets
> up and populates a hash table with allocations of temporaries.
> Deallocation removes the entries and anything that is left at the end
> of execution represents a memory leak. ?The modifications to trans*.c
> implement the calls when memory is alloctaed or freed, if the
> runtime-check flag is set.
>
> Bootstrapped and regtested on FC9/x86_i64.
>
> OK to go on ice ready for 4.5? ?(Is there any appetite to add it to 4.4?)
>
> Paul
>
> 2008-11-28 ?Francois-Xavier Coudert ?<fxcoudert@gcc.gnu.org>
> ? ? ? ? ? ? ? ?Paul Thomas ?<pault@gcc.gnu.org>
>
> ? ? ? ?* Makefile.in : Add runtime/memory_check.c and .lo.
> ? ? ? ?* runtime/memory_check.c : New file containing:
> ? ? ? ?(pretty_memsize, hashval, hasheq, do_nothing,
> ? ? ? ?egister_allocation, malloc_check, register_deallocation,
> ? ? ? ?free_check, realloc_check, report_callback,
> ? ? ? ?memory_check_report): New functions.
> ? ? ? ?* libgfortran.h : Add prototypes for malloc_check,
> ? ? ? ?free_check, realloc_check and memory_check_report.
> ? ? ? ?* Makefile.am : Add runtime/memory_check.c.
>
> 2008-11-28 ?Francois-Xavier Coudert ?<fxcoudert@gcc.gnu.org>
> ? ? ? ? ? ? ? ?Paul Thomas ?<pault@gcc.gnu.org>
>
> ? ? ? ?* trans-expr.c (gfc_conv_string_tmp): Update arguments for call
> ? ? ? ?to gfc_call_free.
> ? ? ? ?* trans-array.c (gfc_trans_allocate_array_storage): Add call
> ? ? ? ?to gfc_allocate_with_status, if checking memory leaks and
> ? ? ? ?extend argument to gfc_call_free.
> ? ? ? ?(gfc_allocate_with_status): Extend arguments for calls to
> ? ? ? ?gfc_allocate_with_status and gfc_allocate_array_with_status.
> ? ? ? ?(gfc_array_deallocate): Add locus* to function declaration.
> ? ? ? ?(gfc_array_deallocate): Add final argument to call to
> ? ? ? ?gfc_deallocate_with_status.
> ? ? ? ?(gfc_trans_auto_array_allocation): If -fmemleaks is set, call
> ? ? ? ?gfc_allocate_with_status. Extend the arglist for gfc_call_free
> ? ? ? ?(gfc_trans_dummy_array_bias): The same.
> ? ? ? ?(gfc_conv_array_parameter): The same.
> ? ? ? ?(gfc_trans_dealloc_allocated): Extend arguments for call to
> ? ? ? ?gfc_deallocate_with_status.
> ? ? ? ?(gfc_duplicate_allocatable): Extend arguments for call to
> ? ? ? ?gfc_allocate_with_status.
> ? ? ? ?* trans-array.h : Modify prototype for gfc_array_deallocate.
> ? ? ? ?trans-openmp.c (gfc_omp_clause_default_ctor): Extend args for
> ? ? ? ?call to gfc_allocate_array_with_status.
> ? ? ? ?(gfc_omp_clause_copy_ctor): The same.
> ? ? ? ?(gfc_trans_omp_array_reduction): The same.
> ? ? ? ?* gfortran.h : Declare rtcheck.
> ? ? ? ?* lang-opt : Correct --ffpe-trap and add -fruntime-check.
> ? ? ? ?* trans-stmt.c (gfc_trans_assign_need_temp): Add arg to call
> ? ? ? ?to gfc_call_free.
> ? ? ? ?(gfc_trans_pointer_assign_need_temp): The same.
> ? ? ? ?(gfc_trans_pointer_assign_need_temp): The same.
> ? ? ? ?(gfc_trans_forall_1, gfc_trans_where_2): The same.
> ? ? ? ?(gfc_trans_allocate): Add arg to call to
> ? ? ? ?gfc_allocate_with_status.
> ? ? ? ?(gfc_trans_deallocate): Add arg to calls to
> ? ? ? ?gfc_array_deallocate and gfc_deallocate_with_status.
> ? ? ? ?* libfortran.h : Add bitmasks for the various runtime checks
> ? ? ? ?and an enum for the allocataion types.
> ? ? ? ?* trans.c (gfc_allocate_with_status): Add arg to decl and code
> ? ? ? ?for real-time checking.
> ? ? ? ?(gfc_allocate_array_with_status, gfc_call_free): The same.
> ? ? ? ?(gfc_deallocate_with_status, gfc_call_realloc): The same.
> ? ? ? ?(gfc_trans_code): Update gfc_current_locus from gfc_code.
> ? ? ? ?* trans.h: Modify prototypes for the above and add tree
> ? ? ? ?decls for gfor_fndecl_malloc_check, gfor_fndecl_free_check,
> ? ? ? ?gfor_fndecl_realloc_check and gfor_fndecl_memory_check_report.
> ? ? ? ?* gfortranspec.c : Add -liberty and remove -lg2c.
> ? ? ? ?* trans-decl.c (gfc_build_builtin_function_decls): Add the
> ? ? ? ?memory checking functions and build them if memory checking
> ? ? ? ?is enabled.
> ? ? ? ?* trans-intrinsic.c (gfc_conv_intrinsic_conversion,
> ? ? ? ?gfc_conv_intrinsic_ctime, gfc_conv_intrinsic_fdate,
> ? ? ? ?gfc_conv_intrinsic_ttynam, gfc_conv_intrinsic_minmax_char,
> ? ? ? ?gfc_conv_intrinsic_array_transfer, gfc_conv_intrinsic_trim):
> ? ? ? ?Add extra args to calls to gfc_call_free.
> ? ? ? ?* options.c (gfc_init_options): Add real time checking.
> ? ? ? ?(gfc_handle_runtime_check_option): New function.
> ? ? ? ?(gfc_handle_option): Add case of runtime_check.
>
> 2008-11-28 ?Paul Thomas ?<pault@gcc.gnu.org>
>
> ? ? ? ?* gfortran.dg/mem_check_1.f90: New test.
>
Index: gcc/testsuite/gfortran.dg/mem_check_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/mem_check_1.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/mem_check_1.f90	(revision 0)
@@ -0,0 +1,11 @@
+! { dg-do run }
+! { dg-options "-fcheck=memleaks" }
+!
+! Test the runtime check for memory leaks.
+!
+  integer(4), pointer :: i(:), j(:)
+  allocate (i(10))
+  allocate (j(10))
+end
+! { dg-output "found 2 memory leaks" }
+
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c	(revision 146619)
+++ gcc/fortran/trans-array.c	(working copy)
@@ -541,7 +541,11 @@ gfc_trans_allocate_array_storage (stmtbl
 	  /* Allocate memory to hold the data or call internal_pack.  */
 	  if (initial == NULL_TREE)
 	    {
-	      tmp = gfc_call_malloc (pre, NULL, size);
+	      if (gfc_option.rtcheck & GFC_RTCHECK_MEMLEAKS)
+		tmp = gfc_allocate_with_status (pre, size, NULL_TREE,
+						&gfc_current_locus);
+	      else
+		tmp = gfc_call_malloc (pre, NULL, size);
 	      tmp = gfc_evaluate_now (tmp, pre);
 	    }
 	  else
@@ -599,7 +603,8 @@ gfc_trans_allocate_array_storage (stmtbl
     {
       /* Free the temporary.  */
       tmp = gfc_conv_descriptor_data_get (desc);
-      tmp = gfc_call_free (fold_convert (pvoid_type_node, tmp));
+      tmp = gfc_call_free (tmp, true, &gfc_current_locus,
+			   ALLOCTYPE_TEMPORARY);
       gfc_add_expr_to_block (post, tmp);
     }
 }
@@ -3924,9 +3929,10 @@ gfc_array_allocate (gfc_se * se, gfc_exp
 
   /* The allocate_array variants take the old pointer as first argument.  */
   if (allocatable_array)
-    tmp = gfc_allocate_array_with_status (&se->pre, pointer, size, pstat, expr);
+    tmp = gfc_allocate_array_with_status (&se->pre, pointer, size, pstat,
+					  expr, &expr->where);
   else
-    tmp = gfc_allocate_with_status (&se->pre, size, pstat);
+    tmp = gfc_allocate_with_status (&se->pre, size, pstat, &expr->where);
   tmp = fold_build2 (MODIFY_EXPR, void_type_node, pointer, tmp);
   gfc_add_expr_to_block (&se->pre, tmp);
 
@@ -3950,7 +3956,8 @@ gfc_array_allocate (gfc_se * se, gfc_exp
 /*GCC ARRAYS*/
 
 tree
-gfc_array_deallocate (tree descriptor, tree pstat, gfc_expr* expr)
+gfc_array_deallocate (tree descriptor, tree pstat,
+		      gfc_expr* expr, locus *loc)
 {
   tree var;
   tree tmp;
@@ -3962,7 +3969,7 @@ gfc_array_deallocate (tree descriptor, t
   STRIP_NOPS (var);
 
   /* Parameter is the address of the data component.  */
-  tmp = gfc_deallocate_with_status (var, pstat, false, expr);
+  tmp = gfc_deallocate_with_status (var, pstat, false, expr, loc);
   gfc_add_expr_to_block (&block, tmp);
 
   /* Zero the data pointer.  */
@@ -4268,7 +4275,12 @@ gfc_trans_auto_array_allocation (tree de
 		      fold_convert (gfc_array_index_type, tmp));
 
   /* Allocate memory to hold the data.  */
-  tmp = gfc_call_malloc (&block, TREE_TYPE (decl), size);
+  if (gfc_option.rtcheck & GFC_RTCHECK_MEMLEAKS)
+    tmp = gfc_allocate_with_status (&block, size, NULL_TREE,
+				    &gfc_current_locus);
+  else
+    tmp = gfc_call_malloc (&block, NULL, size);
+  tmp = fold_convert (TREE_TYPE (decl), tmp);
   gfc_add_modify (&block, decl, tmp);
 
   /* Set offset of the array.  */
@@ -4282,7 +4294,8 @@ gfc_trans_auto_array_allocation (tree de
   gfc_add_expr_to_block (&block, fnbody);
 
   /* Free the temporary.  */
-  tmp = gfc_call_free (convert (pvoid_type_node, decl));
+  tmp = gfc_call_free (decl, true, &gfc_current_locus,
+		       ALLOCTYPE_TEMPORARY);
   gfc_add_expr_to_block (&block, tmp);
 
   return gfc_finish_block (&block);
@@ -4644,7 +4657,8 @@ gfc_trans_dummy_array_bias (gfc_symbol *
 	}
 
       /* Free the temporary.  */
-      tmp = gfc_call_free (tmpdesc);
+      tmp = gfc_call_free (tmpdesc, true, &gfc_current_locus,
+			   ALLOCTYPE_TEMPORARY);
       gfc_add_expr_to_block (&cleanup, tmp);
 
       stmt = gfc_finish_block (&cleanup);
@@ -5498,7 +5512,8 @@ gfc_conv_array_parameter (gfc_se * se, g
 	}
 
       /* Free the temporary.  */
-      tmp = gfc_call_free (convert (pvoid_type_node, ptr));
+      tmp = gfc_call_free (ptr, true, &gfc_current_locus,
+			   ALLOCTYPE_TEMPORARY);
       gfc_add_expr_to_block (&block, tmp);
 
       stmt = gfc_finish_block (&block);
@@ -5543,7 +5558,8 @@ gfc_trans_dealloc_allocated (tree descri
   /* Call array_deallocate with an int * present in the second argument.
      Although it is ignored here, it's presence ensures that arrays that
      are already deallocated are ignored.  */
-  tmp = gfc_deallocate_with_status (var, NULL_TREE, true, NULL);
+  tmp = gfc_deallocate_with_status (var, NULL_TREE, true, NULL,
+				    &gfc_current_locus);
   gfc_add_expr_to_block (&block, tmp);
 
   /* Zero the data pointer.  */
@@ -5602,8 +5618,9 @@ gfc_duplicate_allocatable(tree dest, tre
 				    TYPE_SIZE_UNIT (gfc_get_element_type (type))));
 
   /* Allocate memory to the destination.  */
-  tmp = gfc_call_malloc (&block, TREE_TYPE (gfc_conv_descriptor_data_get (src)),
-			 size);
+  tmp = gfc_allocate_with_status (&block, size, NULL_TREE,
+				  &gfc_current_locus);
+  tmp = fold_convert (TREE_TYPE (gfc_conv_descriptor_data_get (src)), tmp);
   gfc_conv_descriptor_data_set (&block, dest, tmp);
 
   /* We know the temporary and the value will be the same length,
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(revision 146619)
+++ gcc/fortran/trans-expr.c	(working copy)
@@ -1119,7 +1119,8 @@ gfc_conv_string_tmp (gfc_se * se, tree t
       gfc_add_modify (&se->pre, var, tmp);
 
       /* Free the temporary afterwards.  */
-      tmp = gfc_call_free (convert (pvoid_type_node, var));
+      tmp = gfc_call_free (var, true, &gfc_current_locus,
+			   ALLOCTYPE_TEMPORARY);
       gfc_add_expr_to_block (&se->post, tmp);
     }
 
Index: gcc/fortran/trans-array.h
===================================================================
--- gcc/fortran/trans-array.h	(revision 146619)
+++ gcc/fortran/trans-array.h	(working copy)
@@ -20,7 +20,7 @@ along with GCC; see the file COPYING3.
 <http://www.gnu.org/licenses/>.  */
 
 /* Generate code to free an array.  */
-tree gfc_array_deallocate (tree, tree, gfc_expr*);
+tree gfc_array_deallocate (tree, tree, gfc_expr*, locus *);
 
 /* Generate code to initialize an allocate an array.  Statements are added to
    se, which should contain an expression for the array descriptor.  */
Index: gcc/fortran/trans-openmp.c
===================================================================
--- gcc/fortran/trans-openmp.c	(revision 146619)
+++ gcc/fortran/trans-openmp.c	(working copy)
@@ -164,7 +164,7 @@ gfc_omp_clause_default_ctor (tree clause
   size = gfc_evaluate_now (fold_convert (size_type_node, size), &cond_block);
   ptr = gfc_allocate_array_with_status (&cond_block,
 					build_int_cst (pvoid_type_node, 0),
-					size, NULL, NULL);
+					size, NULL, NULL, &gfc_current_locus);
   gfc_conv_descriptor_data_set (&cond_block, decl, ptr);
   then_b = gfc_finish_block (&cond_block);
 
@@ -216,7 +216,7 @@ gfc_omp_clause_copy_ctor (tree clause, t
   size = gfc_evaluate_now (fold_convert (size_type_node, size), &block);
   ptr = gfc_allocate_array_with_status (&block,
 					build_int_cst (pvoid_type_node, 0),
-					size, NULL, NULL);
+					size, NULL, NULL, &gfc_current_locus);
   gfc_conv_descriptor_data_set (&block, dest, ptr);
   call = build_call_expr (built_in_decls[BUILT_IN_MEMCPY], 3, ptr,
 			  fold_convert (pvoid_type_node,
@@ -620,7 +620,7 @@ gfc_trans_omp_array_reduction (tree c, g
       size = gfc_evaluate_now (fold_convert (size_type_node, size), &block);
       ptr = gfc_allocate_array_with_status (&block,
 					    build_int_cst (pvoid_type_node, 0),
-					    size, NULL, NULL);
+					    size, NULL, NULL, &gfc_current_locus);
       gfc_conv_descriptor_data_set (&block, decl, ptr);
       gfc_add_expr_to_block (&block, gfc_trans_assignment (e1, e2, false));
       stmt = gfc_finish_block (&block);
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c	(revision 146619)
+++ gcc/fortran/trans-stmt.c	(working copy)
@@ -2552,7 +2552,8 @@ gfc_trans_assign_need_temp (gfc_expr * e
   if (ptemp1)
     {
       /* Free the temporary.  */
-      tmp = gfc_call_free (ptemp1);
+      tmp = gfc_call_free (ptemp1, true, &gfc_current_locus,
+			   ALLOCTYPE_TEMPORARY);
       gfc_add_expr_to_block (block, tmp);
     }
 }
@@ -2711,7 +2712,8 @@ gfc_trans_pointer_assign_need_temp (gfc_
   /* Free the temporary.  */
   if (ptemp1)
     {
-      tmp = gfc_call_free (ptemp1);
+      tmp = gfc_call_free (ptemp1, true, &gfc_current_locus,
+			   ALLOCTYPE_TEMPORARY);
       gfc_add_expr_to_block (block, tmp);
     }
 }
@@ -3058,7 +3060,8 @@ gfc_trans_forall_1 (gfc_code * code, for
   if (pmask)
     {
       /* Free the temporary for the mask.  */
-      tmp = gfc_call_free (pmask);
+      tmp = gfc_call_free (pmask, true, &gfc_current_locus,
+			   ALLOCTYPE_TEMPORARY);
       gfc_add_expr_to_block (&block, tmp);
     }
   if (maskindex)
@@ -3667,14 +3670,16 @@ gfc_trans_where_2 (gfc_code * code, tree
   /* If we allocated a pending mask array, deallocate it now.  */
   if (ppmask)
     {
-      tmp = gfc_call_free (ppmask);
+      tmp = gfc_call_free (ppmask, true, &gfc_current_locus,
+			   ALLOCTYPE_TEMPORARY);
       gfc_add_expr_to_block (block, tmp);
     }
 
   /* If we allocated a current mask array, deallocate it now.  */
   if (pcmask)
     {
-      tmp = gfc_call_free (pcmask);
+      tmp = gfc_call_free (pcmask, true, &gfc_current_locus,
+			   ALLOCTYPE_TEMPORARY);
       gfc_add_expr_to_block (block, tmp);
     }
 }
@@ -3972,7 +3977,7 @@ gfc_trans_allocate (gfc_code * code)
 	  if (expr->ts.type == BT_CHARACTER && tmp == NULL_TREE)
 	    tmp = se.string_length;
 
-	  tmp = gfc_allocate_with_status (&se.pre, tmp, pstat);
+	  tmp = gfc_allocate_with_status (&se.pre, tmp, pstat, &expr->where);
 	  tmp = fold_build2 (MODIFY_EXPR, void_type_node, se.expr,
 			     fold_convert (TREE_TYPE (se.expr), tmp));
 	  gfc_add_expr_to_block (&se.pre, tmp);
@@ -4112,10 +4117,11 @@ gfc_trans_deallocate (gfc_code *code)
 	}
 
       if (expr->rank)
-	tmp = gfc_array_deallocate (se.expr, pstat, expr);
+	tmp = gfc_array_deallocate (se.expr, pstat, expr, &expr->where);
       else
 	{
-	  tmp = gfc_deallocate_with_status (se.expr, pstat, false, expr);
+	  tmp = gfc_deallocate_with_status (se.expr, pstat, false,
+					    expr, &expr->where);
 	  gfc_add_expr_to_block (&se.pre, tmp);
 
 	  tmp = fold_build2 (MODIFY_EXPR, void_type_node,
Index: gcc/fortran/libgfortran.h
===================================================================
--- gcc/fortran/libgfortran.h	(revision 146619)
+++ gcc/fortran/libgfortran.h	(working copy)
@@ -45,8 +45,11 @@ along with GCC; see the file COPYING3.
 #define GFC_RTCHECK_ARRAY_TEMPS (1<<1)
 #define GFC_RTCHECK_RECURSION   (1<<2)
 #define GFC_RTCHECK_DO          (1<<3)
+#define GFC_RTCHECK_MEMUSAGE    (1<<4)
+#define GFC_RTCHECK_MEMLEAKS    (1<<5)
 #define GFC_RTCHECK_ALL        (GFC_RTCHECK_BOUNDS | GFC_RTCHECK_ARRAY_TEMPS \
-				| GFC_RTCHECK_RECURSION | GFC_RTCHECK_DO)
+				| GFC_RTCHECK_RECURSION | GFC_RTCHECK_DO \
+				| GFC_RTCHECK_MEMUSAGE | GFC_RTCHECK_MEMLEAKS)
 
 
 /* Possible values for the CONVERT I/O specifier.  */
@@ -118,3 +121,12 @@ enum
   GFC_DTYPE_CHARACTER
 };
 
+
+/* Allocation types for the checking memory management routines.  */
+enum
+{
+  ALLOCTYPE_ALLOCATE,	/* ALLOCATE, DEALLOCATE and MOVE_ALLOC statements.  */
+  ALLOCTYPE_MALLOC,	/* MALLOC, REALLOC and FREE extension routines.  */
+  ALLOCTYPE_TEMPORARY	/* Allocation for temporaries.  */
+};
+
Index: gcc/fortran/trans.c
===================================================================
--- gcc/fortran/trans.c	(revision 146619)
+++ gcc/fortran/trans.c	(working copy)
@@ -584,7 +584,8 @@ gfc_call_malloc (stmtblock_t * block, tr
       return newmem;
     }  */
 tree
-gfc_allocate_with_status (stmtblock_t * block, tree size, tree status)
+gfc_allocate_with_status (stmtblock_t * block, tree size, tree status,
+			  locus *loc)
 {
   stmtblock_t alloc_block;
   tree res, tmp, error, msg, cond;
@@ -637,11 +638,19 @@ gfc_allocate_with_status (stmtblock_t *
 
   /* The allocation itself.  */
   gfc_start_block (&alloc_block);
-  gfc_add_modify (&alloc_block, res,
-		       build_call_expr (built_in_decls[BUILT_IN_MALLOC], 1,
-					fold_build2 (MAX_EXPR, size_type_node,
-						     size,
-						     build_int_cst (size_type_node, 1))));
+  if (gfc_option.rtcheck & GFC_RTCHECK_MEMLEAKS)
+    gfc_add_modify (&alloc_block, res,
+      build_call_expr (gfor_fndecl_malloc_check, 4, size,
+		       gfc_build_addr_expr (pchar_type_node,
+			 gfc_build_cstring_const (loc->lb->file->filename)),
+		       build_int_cst (integer_type_node,
+				      LOCATION_LINE (loc->lb->location)),
+		       build_int_cst (integer_type_node, ALLOCTYPE_ALLOCATE)));
+  else
+    gfc_add_modify (&alloc_block, res,
+		    build_call_expr (built_in_decls[BUILT_IN_MALLOC], 1,
+		      fold_build2 (MAX_EXPR, size_type_node, size,
+				   build_int_cst (size_type_node, 1))));
 
   msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const
 						("Out of memory"));
@@ -705,7 +714,7 @@ gfc_allocate_with_status (stmtblock_t *
     and variable name in case a runtime error has to be printed.  */
 tree
 gfc_allocate_array_with_status (stmtblock_t * block, tree mem, tree size,
-				tree status, gfc_expr* expr)
+				tree status, gfc_expr* expr, locus *loc)
 {
   stmtblock_t alloc_block;
   tree res, tmp, null_mem, alloc, error;
@@ -721,7 +730,7 @@ gfc_allocate_array_with_status (stmtbloc
 
   /* If mem is NULL, we call gfc_allocate_with_status.  */
   gfc_start_block (&alloc_block);
-  tmp = gfc_allocate_with_status (&alloc_block, size, status);
+  tmp = gfc_allocate_with_status (&alloc_block, size, status, loc);
   gfc_add_modify (&alloc_block, res, fold_convert (type, tmp));
   alloc = gfc_finish_block (&alloc_block);
 
@@ -750,11 +759,10 @@ gfc_allocate_array_with_status (stmtbloc
       stmtblock_t set_status_block;
 
       gfc_start_block (&set_status_block);
-      tmp = build_call_expr (built_in_decls[BUILT_IN_FREE], 1,
-			     fold_convert (pvoid_type_node, mem));
+      tmp = gfc_call_free (mem, false, loc, ALLOCTYPE_ALLOCATE);
       gfc_add_expr_to_block (&set_status_block, tmp);
 
-      tmp = gfc_allocate_with_status (&set_status_block, size, status);
+      tmp = gfc_allocate_with_status (&set_status_block, size, status, loc);
       gfc_add_modify (&set_status_block, res, fold_convert (type, tmp));
 
       gfc_add_modify (&set_status_block,
@@ -774,29 +782,51 @@ gfc_allocate_array_with_status (stmtbloc
 }
 
 
-/* Free a given variable, if it's not NULL.  */
+/* Free a given variable. We possibly check if it's NULL (if argument
+   nullcheck is true. */
 tree
-gfc_call_free (tree var)
+gfc_call_free (tree var, bool nullcheck, locus *loc, int type)
 {
   stmtblock_t block;
-  tree tmp, cond, call;
+  tree tmp, call, cond = NULL_TREE;
 
   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);
+  if (nullcheck)
+    {
+      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));
+    }
 
-  return gfc_finish_block (&block);
-}
+  if (gfc_option.rtcheck & GFC_RTCHECK_MEMLEAKS)
+    {
+      int line = loc ? LOCATION_LINE (loc->lb->location) : 0;
+      tree file = loc
+	? gfc_build_addr_expr (pchar_type_node,
+	    gfc_build_cstring_const (loc->lb->file->filename))
+	: build_int_cst (pchar_type_node, 0);
 
+      call = build_call_expr (gfor_fndecl_free_check, 4, var, file,
+			      build_int_cst (integer_type_node, line),
+			      build_int_cst (integer_type_node, type));
+    }
+  else
+    call = build_call_expr (built_in_decls[BUILT_IN_FREE], 1, var);
 
+  if (nullcheck)
+    {
+      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);
+    }
+  else
+    return call;
+}
+  
 
 /* User-deallocate; we emit the code directly from the front-end, and the
    logic is the same as the previous library function:
@@ -829,7 +859,7 @@ gfc_call_free (tree var)
    expression being deallocated for its locus and variable name.  */
 tree
 gfc_deallocate_with_status (tree pointer, tree status, bool can_fail,
-			    gfc_expr* expr)
+			    gfc_expr* expr, locus *loc)
 {
   stmtblock_t null, non_null;
   tree cond, tmp, error;
@@ -873,8 +903,7 @@ gfc_deallocate_with_status (tree pointer
 
   /* When POINTER is not NULL, we free it.  */
   gfc_start_block (&non_null);
-  tmp = build_call_expr (built_in_decls[BUILT_IN_FREE], 1,
-			 fold_convert (pvoid_type_node, pointer));
+  tmp = gfc_call_free (pointer, false, loc, ALLOCTYPE_ALLOCATE);
   gfc_add_expr_to_block (&non_null, tmp);
 
   if (status != NULL_TREE && !integer_zerop (status))
@@ -940,8 +969,16 @@ gfc_call_realloc (stmtblock_t * block, t
   gfc_add_expr_to_block (block, tmp);
 
   /* Call realloc and check the result.  */
-  tmp = build_call_expr (built_in_decls[BUILT_IN_REALLOC], 2,
-			 fold_convert (pvoid_type_node, mem), size);
+  if (gfc_option.rtcheck & GFC_RTCHECK_MEMLEAKS)
+    tmp = build_call_expr (gfor_fndecl_realloc_check, 5,
+			   fold_convert (pvoid_type_node, mem), size,
+			   build_int_cst (pchar_type_node, 0),
+			   build_int_cst (integer_type_node, 0),
+			   build_int_cst (integer_type_node,
+					  ALLOCTYPE_TEMPORARY));
+  else
+    tmp = build_call_expr (built_in_decls[BUILT_IN_REALLOC], 2,
+			   fold_convert (pvoid_type_node, mem), size);
   gfc_add_modify (block, res, fold_convert (type, tmp));
   null_result = fold_build2 (EQ_EXPR, boolean_type_node, res,
 			     build_int_cst (pvoid_type_node, 0));
@@ -1036,16 +1073,20 @@ gfc_trans_code (gfc_code * code)
 {
   stmtblock_t block;
   tree res;
+  locus saved_locus;
 
   if (!code)
     return build_empty_stmt ();
 
+  saved_locus = gfc_current_locus;
+
   gfc_start_block (&block);
 
   /* Translate statements one by one into GENERIC trees until we reach
      the end of this gfc_code branch.  */
   for (; code; code = code->next)
     {
+      gfc_current_locus = code->loc;
       if (code->here != 0)
 	{
 	  res = gfc_trans_label_here (code);
@@ -1248,6 +1289,8 @@ gfc_trans_code (gfc_code * code)
 	}
     }
 
+  gfc_current_locus = saved_locus;
+
   /* Return the finished block.  */
   return gfc_finish_block (&block);
 }
Index: gcc/fortran/trans.h
===================================================================
--- gcc/fortran/trans.h	(revision 146619)
+++ gcc/fortran/trans.h	(working copy)
@@ -461,8 +461,8 @@ void gfc_trans_runtime_check (bool, bool
 void gfc_trans_same_strlen_check (const char*, locus*, tree, tree,
 				  stmtblock_t*);
 
-/* Generate a call to free() after checking that its arg is non-NULL.  */
-tree gfc_call_free (tree);
+/* Generate a call to free() after possibly checking that its arg is non-NULL.  */
+tree gfc_call_free (tree, bool, locus *, int);
 
 /* Allocate memory after performing a few checks.  */
 tree gfc_call_malloc (stmtblock_t *, tree, tree);
@@ -471,13 +471,13 @@ tree gfc_call_malloc (stmtblock_t *, tre
 tree gfc_build_memcpy_call (tree, tree, tree);
 
 /* Allocate memory for arrays, with optional status variable.  */
-tree gfc_allocate_array_with_status (stmtblock_t*, tree, tree, tree, gfc_expr*);
+tree gfc_allocate_array_with_status (stmtblock_t*, tree, tree, tree, gfc_expr*, locus *);
 
 /* Allocate memory, with optional status variable.  */
-tree gfc_allocate_with_status (stmtblock_t *, tree, tree);
+tree gfc_allocate_with_status (stmtblock_t *, tree, tree, locus *);
 
 /* Generate code to deallocate an array.  */
-tree gfc_deallocate_with_status (tree, tree, bool, gfc_expr*);
+tree gfc_deallocate_with_status (tree, tree, bool, gfc_expr*, locus *);
 
 /* Generate code to call realloc().  */
 tree gfc_call_realloc (stmtblock_t *, tree, tree);
@@ -538,6 +538,10 @@ extern GTY(()) tree gfor_fndecl_fdate;
 extern GTY(()) tree gfor_fndecl_in_pack;
 extern GTY(()) tree gfor_fndecl_in_unpack;
 extern GTY(()) tree gfor_fndecl_associated;
+extern GTY(()) tree gfor_fndecl_malloc_check;
+extern GTY(()) tree gfor_fndecl_free_check;
+extern GTY(()) tree gfor_fndecl_realloc_check;
+extern GTY(()) tree gfor_fndecl_memory_check_report;
 
 /* Math functions.  Many other math functions are handled in
    trans-intrinsic.c.  */
Index: gcc/fortran/gfortranspec.c
===================================================================
--- gcc/fortran/gfortranspec.c	(revision 146619)
+++ gcc/fortran/gfortranspec.c	(working copy)
@@ -27,13 +27,13 @@ along with GCC; see the file COPYING3.
    unless explicitly overridden by the user in certain ways, ensure
    that the needs of the language supported by this wrapper are met.
 
-   For GNU Fortran 95(gfortran), we do the following to the argument list
+   For GNU Fortran (gfortran), we do the following to the argument list
    before passing it to `gcc':
 
-   1.  Make sure `-lgfortran -lm' is at the end of the list.
+   1.  Make sure `-lgfortran -liberty -lm' is at the end of the list.
 
    2.  Make sure each time `-lgfortran' or `-lm' is seen, it forms
-       part of the series `-lgfortran -lm'.
+       part of the series `-lgfortran -liberty -lm'.
 
    #1 and #2 are not done if `-nostdlib' or any option that disables
    the linking phase is present, or if `-xfoo' is in effect.  Note that
@@ -518,6 +518,7 @@ For more information about these matters
 	    {
 	      saw_library = 1;	/* -l<library>.  */
 	      ADD_ARG_LIBGFORTRAN (argv[i]);
+	      append_arg ("-liberty");
 	      continue;
 	    }
 	  else
@@ -530,7 +531,7 @@ For more information about these matters
       append_arg (argv[i]);
     }
 
-  /* Append `-lg2c -lm' as necessary.  */
+  /* Append `-lm' as necessary.  */
 
   if (library)
     {				/* Doing a link and no -nostdlib.  */
@@ -549,6 +550,7 @@ For more information about these matters
 	  /* Fall through.  */
 
 	case 1:
+	  append_arg ("-liberty");
 	  if (need_math)
 	    append_arg (MATH_LIBRARY);
 	default:
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(revision 146619)
+++ gcc/fortran/trans-decl.c	(working copy)
@@ -94,6 +94,10 @@ tree gfor_fndecl_ttynam;
 tree gfor_fndecl_in_pack;
 tree gfor_fndecl_in_unpack;
 tree gfor_fndecl_associated;
+tree gfor_fndecl_malloc_check;
+tree gfor_fndecl_free_check;
+tree gfor_fndecl_realloc_check;
+tree gfor_fndecl_memory_check_report;
 
 
 /* Math functions.  Many other math functions are handled in
@@ -2622,6 +2626,29 @@ gfc_build_builtin_function_decls (void)
                                      integer_type_node, 2, ppvoid_type_node,
                                      ppvoid_type_node);
 
+  /* Memory checking functions.  */
+  gfor_fndecl_malloc_check =
+    gfc_build_library_function_decl (get_identifier (PREFIX("malloc_check")),
+				     pvoid_type_node, 4, size_type_node,
+				     pchar_type_node, integer_type_node,
+				     integer_type_node);
+
+  gfor_fndecl_free_check =
+    gfc_build_library_function_decl (get_identifier (PREFIX("free_check")),
+				     void_type_node, 4, pvoid_type_node,
+				     pchar_type_node, integer_type_node,
+				     integer_type_node);
+
+  gfor_fndecl_realloc_check =
+    gfc_build_library_function_decl (get_identifier (PREFIX("realloc_check")),
+				     pvoid_type_node, 5, pvoid_type_node,
+				     size_type_node, pchar_type_node,
+				     integer_type_node, integer_type_node);
+
+  gfor_fndecl_memory_check_report =
+    gfc_build_library_function_decl (get_identifier (PREFIX("memory_check_report")),
+				     void_type_node, 0);
+
   gfc_build_intrinsic_function_decls ();
   gfc_build_intrinsic_lib_fndecls ();
   gfc_build_io_library_fndecls ();
@@ -4086,6 +4113,13 @@ gfc_generate_function_code (gfc_namespac
       }
     }
 
+  /* For main program, when memory runtime checking is enabled,
+     print out a final report.  */
+  if (sym->attr.is_main_program && gfc_option.rtcheck & GFC_RTCHECK_MEMLEAKS)
+    {
+      tmp = build_call_expr (gfor_fndecl_memory_check_report, 0);
+      gfc_add_expr_to_block (&block, tmp);
+    }
 
   /* Add all the decls we created during processing.  */
   decl = saved_function_decls;
Index: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c	(revision 146619)
+++ gcc/fortran/trans-intrinsic.c	(working copy)
@@ -275,7 +275,7 @@ gfc_conv_intrinsic_conversion (gfc_se *
       gfc_add_expr_to_block (&se->pre, tmp);
 
       /* Free the temporary afterwards.  */
-      tmp = gfc_call_free (var);
+      tmp = gfc_call_free (var, true, &gfc_current_locus, ALLOCTYPE_TEMPORARY);
       gfc_add_expr_to_block (&se->post, tmp);
 
       se->expr = var;
@@ -1385,7 +1385,8 @@ gfc_conv_intrinsic_ctime (gfc_se * se, g
   /* Free the temporary afterwards, if necessary.  */
   cond = fold_build2 (GT_EXPR, boolean_type_node,
 		      len, build_int_cst (TREE_TYPE (len), 0));
-  tmp = gfc_call_free (var);
+  tmp = gfc_call_free (var, true, &gfc_current_locus,
+		       ALLOCTYPE_TEMPORARY);
   tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
   gfc_add_expr_to_block (&se->post, tmp);
 
@@ -1423,7 +1424,8 @@ gfc_conv_intrinsic_fdate (gfc_se * se, g
   /* Free the temporary afterwards, if necessary.  */
   cond = fold_build2 (GT_EXPR, boolean_type_node,
 		      len, build_int_cst (TREE_TYPE (len), 0));
-  tmp = gfc_call_free (var);
+  tmp = gfc_call_free (var, true, &gfc_current_locus,
+		       ALLOCTYPE_TEMPORARY);
   tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
   gfc_add_expr_to_block (&se->post, tmp);
 
@@ -1463,7 +1465,8 @@ gfc_conv_intrinsic_ttynam (gfc_se * se,
   /* Free the temporary afterwards, if necessary.  */
   cond = fold_build2 (GT_EXPR, boolean_type_node,
 		      len, build_int_cst (TREE_TYPE (len), 0));
-  tmp = gfc_call_free (var);
+  tmp = gfc_call_free (var, true, &gfc_current_locus,
+		       ALLOCTYPE_TEMPORARY);
   tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
   gfc_add_expr_to_block (&se->post, tmp);
 
@@ -1598,7 +1601,8 @@ gfc_conv_intrinsic_minmax_char (gfc_se *
   /* Free the temporary afterwards, if necessary.  */
   cond = fold_build2 (GT_EXPR, boolean_type_node,
 		      len, build_int_cst (TREE_TYPE (len), 0));
-  tmp = gfc_call_free (var);
+  tmp = gfc_call_free (var, true, &gfc_current_locus,
+		       ALLOCTYPE_TEMPORARY);
   tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
   gfc_add_expr_to_block (&se->post, tmp);
 
@@ -3722,7 +3726,8 @@ gfc_conv_intrinsic_transfer (gfc_se * se
 
 	  /* Free the temporary.  */
 	  gfc_start_block (&block);
-	  tmp = gfc_call_free (convert (pvoid_type_node, source));
+	  tmp = gfc_call_free (source, true, &gfc_current_locus,
+			       ALLOCTYPE_TEMPORARY);
 	  gfc_add_expr_to_block (&block, tmp);
 	  stmt = gfc_finish_block (&block);
 
@@ -4220,7 +4225,8 @@ gfc_conv_intrinsic_trim (gfc_se * se, gf
   /* Free the temporary afterwards, if necessary.  */
   cond = fold_build2 (GT_EXPR, boolean_type_node,
 		      len, build_int_cst (TREE_TYPE (len), 0));
-  tmp = gfc_call_free (var);
+  tmp = gfc_call_free (var, true, &gfc_current_locus,
+		       ALLOCTYPE_TEMPORARY);
   tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
   gfc_add_expr_to_block (&se->post, tmp);
 
Index: gcc/fortran/options.c
===================================================================
--- gcc/fortran/options.c	(revision 146619)
+++ gcc/fortran/options.c	(working copy)
@@ -468,10 +468,12 @@ gfc_handle_runtime_check_option (const c
 {
   int result, pos = 0, n;
   static const char * const optname[] = { "all", "bounds", "array-temps",
-					  "recursion", "do", NULL };
+					  "recursion", "do", "memusage",
+					  "memleaks", NULL };
   static const int optmask[] = { GFC_RTCHECK_ALL, GFC_RTCHECK_BOUNDS,
 				 GFC_RTCHECK_ARRAY_TEMPS,
 				 GFC_RTCHECK_RECURSION, GFC_RTCHECK_DO,
+				 GFC_RTCHECK_MEMUSAGE, GFC_RTCHECK_MEMLEAKS,
 				 0 };
  
   while (*arg)
Index: libgfortran/Makefile.in
===================================================================
--- libgfortran/Makefile.in	(revision 146619)
+++ libgfortran/Makefile.in	(working copy)
@@ -79,15 +79,29 @@ toolexeclibLTLIBRARIES_INSTALL = $(INSTA
 LTLIBRARIES = $(myexeclib_LTLIBRARIES) $(toolexeclib_LTLIBRARIES)
 libgfortran_la_LIBADD =
 am__libgfortran_la_SOURCES_DIST = runtime/backtrace.c \
-	runtime/compile_options.c runtime/convert_char.c \
-	runtime/environ.c runtime/error.c runtime/fpu.c runtime/main.c \
-	runtime/memory.c runtime/pause.c runtime/stop.c \
-	runtime/string.c runtime/select.c $(srcdir)/generated/all_l1.c \
-	$(srcdir)/generated/all_l2.c $(srcdir)/generated/all_l4.c \
-	$(srcdir)/generated/all_l8.c $(srcdir)/generated/all_l16.c \
-	$(srcdir)/generated/any_l1.c $(srcdir)/generated/any_l2.c \
-	$(srcdir)/generated/any_l4.c $(srcdir)/generated/any_l8.c \
-	$(srcdir)/generated/any_l16.c $(srcdir)/generated/count_1_l.c \
+	runtime/compile_options.c \
+	runtime/convert_char.c \
+	runtime/environ.c \
+	runtime/error.c \
+	runtime/fpu.c \
+	runtime/main.c \
+	runtime/memory.c \
+	runtime/memory_check.c \
+	runtime/pause.c  \
+	runtime/stop.c  \
+	runtime/string.c \
+	runtime/select.c \
+	$(srcdir)/generated/all_l1.c \
+	$(srcdir)/generated/all_l2.c \
+	$(srcdir)/generated/all_l4.c \
+	$(srcdir)/generated/all_l8.c \
+	$(srcdir)/generated/all_l16.c \
+	$(srcdir)/generated/any_l1.c \
+	$(srcdir)/generated/any_l2.c \
+	$(srcdir)/generated/any_l4.c \
+	$(srcdir)/generated/any_l8.c \
+	$(srcdir)/generated/any_l16.c \
+	$(srcdir)/generated/count_1_l.c \
 	$(srcdir)/generated/count_2_l.c \
 	$(srcdir)/generated/count_4_l.c \
 	$(srcdir)/generated/count_8_l.c \
@@ -581,8 +595,8 @@ am__libgfortran_la_SOURCES_DIST = runtim
 	intrinsics/f2c_specifics.F90 libgfortran_c.c $(filter-out \
 	%.c,$(prereq_SRC))
 am__objects_1 = backtrace.lo compile_options.lo convert_char.lo \
-	environ.lo error.lo fpu.lo main.lo memory.lo pause.lo stop.lo \
-	string.lo select.lo
+	environ.lo error.lo fpu.lo main.lo memory.lo memory_check.lo \
+	pause.lo stop.lo string.lo select.lo
 am__objects_2 = all_l1.lo all_l2.lo all_l4.lo all_l8.lo all_l16.lo
 am__objects_3 = any_l1.lo any_l2.lo any_l4.lo any_l8.lo any_l16.lo
 am__objects_4 = count_1_l.lo count_2_l.lo count_4_l.lo count_8_l.lo \
@@ -963,6 +977,7 @@ libgfortranbegin_la_SOURCES = fmain.c
 libgfortranbegin_la_LDFLAGS = -static
 AM_CPPFLAGS = -iquote$(srcdir)/io -I$(srcdir)/$(MULTISRCTOP)../gcc \
 	      -I$(srcdir)/$(MULTISRCTOP)../gcc/config \
+	      -I$(srcdir)/$(MULTISRCTOP)../include \
 	      -I$(MULTIBUILDTOP)../../$(host_subdir)/gcc -D_GNU_SOURCE
 
 gfor_io_src = \
@@ -1056,6 +1071,7 @@ runtime/error.c \
 runtime/fpu.c \
 runtime/main.c \
 runtime/memory.c \
+runtime/memory_check.c \
 runtime/pause.c \
 runtime/stop.c \
 runtime/string.c \
@@ -1991,6 +2007,7 @@ distclean-compile:
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxval_r4.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxval_r8.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/memory.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/memory_check.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_16_i1.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_16_i16.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_16_i2.Plo@am__quote@
@@ -2725,6 +2742,13 @@ memory.lo: runtime/memory.c
 @AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
 @am__fastdepCC_FALSE@	$(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o memory.lo `test -f 'runtime/memory.c' || echo '$(srcdir)/'`runtime/memory.c
 
+memory_check.lo: runtime/memory_check.c
+@am__fastdepCC_TRUE@	if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT memory_check.lo -MD -MP -MF "$(DEPDIR)/memory_check.Tpo" -c -o memory_check.lo `test -f 'runtime/memory_check.c' || echo '$(srcdir)/'`runtime/memory_check.c; \
+@am__fastdepCC_TRUE@	then mv -f "$(DEPDIR)/memory_check.Tpo" "$(DEPDIR)/memory_check.Plo"; else rm -f "$(DEPDIR)/memory_check.Tpo"; exit 1; fi
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	source='runtime/memory_check.c' object='memory_check.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o memory_check.lo `test -f 'runtime/memory_check.c' || echo '$(srcdir)/'`runtime/memory_check.c
+
 pause.lo: runtime/pause.c
 @am__fastdepCC_TRUE@	if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pause.lo -MD -MP -MF "$(DEPDIR)/pause.Tpo" -c -o pause.lo `test -f 'runtime/pause.c' || echo '$(srcdir)/'`runtime/pause.c; \
 @am__fastdepCC_TRUE@	then mv -f "$(DEPDIR)/pause.Tpo" "$(DEPDIR)/pause.Plo"; else rm -f "$(DEPDIR)/pause.Tpo"; exit 1; fi
Index: libgfortran/runtime/memory_check.c
===================================================================
--- libgfortran/runtime/memory_check.c	(revision 0)
+++ libgfortran/runtime/memory_check.c	(revision 0)
@@ -0,0 +1,255 @@
+/* Instrumented routines for memory management.
+   Copyright 2008 Free Software Foundation, Inc.
+   Contributed by FranÃois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+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 "libgfortran.h"
+#include "hashtab.h"
+
+#include <stdlib.h>
+
+/* Recording the amount of memory used.  */
+static size_t usedmem_temp = 0, peakmem_temp = 0;
+static size_t usedmem_user = 0, peakmem_user = 0;
+static htab_t tab = NULL;
+
+/* A structure to store our allocations in.  */
+typedef struct
+{
+  void *p;
+  size_t size;
+  const char *file;
+  int line;
+} allocation_t;
+
+
+static char *
+pretty_memsize (size_t size)
+{
+  static char buf[40];
+  static const char *mult[] = { "", "K", "M", "G", "T", "P", "E", "Z", "Y",
+				NULL };
+  int m, p;
+  double s;
+
+  m = 0;
+  s = size;
+  while (s > 1024 && mult[m+1] != NULL)
+    s /= 1024, m++;
+  p = (s > 100 ? 0 : (s > 10 ? 1 : 2));
+
+#ifndef HAVE_SNPRINTF
+# define snprintf(format, size, ...) sprintf (format, __VA_ARGS__)
+#endif
+
+  snprintf (buf, sizeof(buf), "%.*f %sB", p, s, mult[m]);
+  return buf;
+}
+
+
+#define new_allocation_t() (malloc(sizeof(allocation_t)))
+
+static hashval_t
+hashval (const void *a)
+{
+  return htab_hash_pointer (((allocation_t *) a)->p);
+}
+
+static int
+hasheq (const void *a, const void *b)
+{
+  return (((allocation_t *) a)->p == ((allocation_t *) b)->p);
+}
+
+static void
+do_nothing (void *a __attribute__((unused)))
+{
+  ;
+}
+
+
+#define INIT { if (tab == NULL) \
+		 tab = htab_create_alloc (128, hashval, hasheq, do_nothing, \
+					  calloc, free); }
+
+static void
+register_allocation (void *p, const size_t size, const char *filename,
+		     const int line, const int type)
+{
+  allocation_t *a, **slot;
+
+  INIT;
+
+  /* Register the usage of memory.  */
+  if (type == ALLOCTYPE_TEMPORARY)
+    {
+      usedmem_temp += size;
+      if (usedmem_temp > peakmem_temp)
+	peakmem_temp = usedmem_temp;
+    }
+  else
+    {
+      usedmem_user += size;
+      if (usedmem_user > peakmem_user)
+	peakmem_user = usedmem_user;
+    }
+
+  /* Register this allocation.  */
+  a = malloc (sizeof (allocation_t));
+  a->p = p;
+  a->size = size;
+  a->file = filename;
+  a->line = line;
+  slot = (allocation_t **) htab_find_slot (tab, a, INSERT);
+  *slot = a;
+}
+
+void *
+malloc_check (size_t size, const char *filename, const int line, const int type)
+{
+  void *p;
+
+  p = malloc (size);
+  if (p)
+    register_allocation (p, size, filename, line, type);
+
+  return p;
+}
+
+
+static void
+register_deallocation (void *p, const char *filename, const int line,
+		       const int type)
+{
+  allocation_t a, **slot;
+
+  INIT;
+
+  a.p = p;
+  slot = (allocation_t **) htab_find_slot (tab, &a, NO_INSERT);
+
+  if (slot && *slot)
+    {
+      /* Successfully found in the allocation table.  */
+      if (type == ALLOCTYPE_TEMPORARY)
+	usedmem_temp -= (*slot)->size;
+      else
+	usedmem_user -= (*slot)->size;
+
+      htab_clear_slot (tab, (void *) slot);
+      return;
+    }
+
+  /* If we come here, we've caught an error.  */
+  if (filename == NULL)
+    st_printf (" !! Memory deallocation error in the code generated by the "
+	       "GNU Fortran compiler.\n !! Please report this issue to "
+	       "http://gcc.gnu.org/bugzilla/\n";);
+  else
+    st_printf ("Error in memory deallocation at line %d of source file '%s': "
+	       "freeing memory that has not been allocated by us.\n", line,
+	       filename);
+
+  sys_exit (2);
+}
+
+void
+free_check (void *p, const char *filename, const int line, const int type)
+{
+  free (p);
+  register_deallocation (p, filename, line, type);
+}
+
+
+void *
+realloc_check (void *p, size_t size, const char *filename, const int line,
+	       const int type)
+{
+  void *newp;
+
+  if (p)
+    register_deallocation (p, filename, line, type);
+
+  newp = realloc (p, size);
+
+  if (newp)
+    register_allocation (newp, size, filename, line, type);
+
+  return newp;
+}
+
+
+/* Report we output when exiting the program.  */
+
+static int
+report_callback (void **slot, void *ptr __attribute__((unused)))
+{
+  static unsigned num = 0;
+  num++;
+
+  if ((*(allocation_t **) slot)->file == NULL)
+    {
+      st_printf (" !! Memory leak in the code generated by the GNU Fortran "
+		 "compiler.\n !! Please report this issue to "
+		 "http://gcc.gnu.org/bugzilla/\n";);
+      return 0;
+    }
+
+  st_printf ("  - at line %d of file '%s', allocation of %s (address %p)\n", 
+	     (*(allocation_t **) slot)->line, (*(allocation_t **) slot)->file,
+	     pretty_memsize ((*(allocation_t **) slot)->size),
+	     (*(allocation_t **) slot)->p);
+  return (num >= 20 ? 0 : 1);
+}
+
+void
+memory_check_report (void)
+{
+  unsigned long n;
+
+  if (tab == NULL)
+    return;
+
+  n = (unsigned long) htab_elements (tab);
+
+  if (n > 0)
+    {
+      st_printf ("\n\nFortran runtime checking: found %lu memory leaks\n", n);
+      htab_traverse_noresize (tab, report_callback, NULL);
+    }
+  else
+    st_printf ("\n\nFortran runtime checks: No memory leak found.\n");
+
+  st_printf ("\n");
+  st_printf ("Peak user-allocated memory: %s\n", pretty_memsize (peakmem_user));
+  st_printf ("Peak memory created by the compiler for temporaries: %s\n",
+	     pretty_memsize (peakmem_temp));
+
+  htab_delete (tab);
+}
+
Index: libgfortran/libgfortran.h
===================================================================
--- libgfortran/libgfortran.h	(revision 146619)
+++ libgfortran/libgfortran.h	(working copy)
@@ -687,6 +687,21 @@ internal_proto(free_mem);
 extern void *internal_malloc_size (size_t) __attribute__ ((malloc));
 internal_proto(internal_malloc_size);
 
+/* memory_check.c */
+
+extern void *malloc_check (size_t, const char *, const int, const int);
+export_proto(malloc_check);
+
+extern void free_check (void *, const char *, const int, const int);
+export_proto(free_check);
+
+extern void * realloc_check (void *, size_t, const char *, const int,
+			     const int);
+export_proto(realloc_check);
+
+extern void memory_check_report (void);
+export_proto(memory_check_report);
+
 /* environ.c */
 
 extern int check_buffered (int);
Index: libgfortran/Makefile.am
===================================================================
--- libgfortran/Makefile.am	(revision 146619)
+++ libgfortran/Makefile.am	(working copy)
@@ -28,6 +28,7 @@ libgfortranbegin_la_LDFLAGS = -static
 ## use -iquote
 AM_CPPFLAGS = -iquote$(srcdir)/io -I$(srcdir)/$(MULTISRCTOP)../gcc \
 	      -I$(srcdir)/$(MULTISRCTOP)../gcc/config \
+	      -I$(srcdir)/$(MULTISRCTOP)../include \
 	      -I$(MULTIBUILDTOP)../../$(host_subdir)/gcc -D_GNU_SOURCE
 
 # Fortran rules for complex multiplication and division
@@ -128,6 +129,7 @@ runtime/error.c \
 runtime/fpu.c \
 runtime/main.c \
 runtime/memory.c \
+runtime/memory_check.c \
 runtime/pause.c \
 runtime/stop.c \
 runtime/string.c \

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