Subversion Repositories openrisc_2011-10-31

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                              G N A T M E M                               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 1997-2008, AdaCore                     --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT 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  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------
 
--  GNATMEM is a utility that tracks memory leaks. It is based on a simple
--  idea:
 
--      - Read the allocation log generated by the application linked using
--        instrumented memory allocation and deallocation (see memtrack.adb for
--        this circuitry). To get access to this functionality, the application
--        must be relinked with library libgmem.a:
 
--            $ gnatmake my_prog -largs -lgmem
 
--        The running my_prog will produce a file named gmem.out that will be
--        parsed by gnatmem.
 
--      - Record a reference to the allocated memory on each allocation call
 
--      - Suppress this reference on deallocation
 
--      - At the end of the program, remaining references are potential leaks.
--        sort them out the best possible way in order to locate the root of
--        the leak.
 
--   This capability is not supported on all platforms, please refer to
--   memtrack.adb for further information.
 
--   In order to help finding out the real leaks,  the notion of "allocation
--   root" is defined. An allocation root is a specific point in the program
--   execution generating memory allocation where data is collected (such as
--   number of allocations, amount of memory allocated, high water mark, etc.)
 
with Ada.Float_Text_IO;
with Ada.Integer_Text_IO;
with Ada.Text_IO;             use Ada.Text_IO;
 
with System;                  use System;
with System.Storage_Elements; use System.Storage_Elements;
 
with GNAT.Command_Line;       use GNAT.Command_Line;
with GNAT.Heap_Sort_G;
with GNAT.OS_Lib;             use GNAT.OS_Lib;
with GNAT.HTable;             use GNAT.HTable;
 
with Gnatvsn; use Gnatvsn;
with Memroot; use Memroot;
 
procedure Gnatmem is
 
   package Int_IO renames Ada.Integer_Text_IO;
 
   ------------------------
   -- Other Declarations --
   ------------------------
 
   type Storage_Elmt is record
      Elmt : Character;
      --  *  = End of log file
      --  A  = found a ALLOC mark in the log
      --  D  = found a DEALL mark in the log
 
      Address : Integer_Address;
      Size    : Storage_Count;
      Timestamp : Duration;
   end record;
   --  This type is used to read heap operations from the log file.
   --  Elmt contains the type of the operation, which can be either
   --  allocation, deallocation, or a special mark indicating the
   --  end of the log file. Address is used to store address on the
   --  heap where a chunk was allocated/deallocated, size is only
   --  for A event and contains size of the allocation, and Timestamp
   --  is the clock value at the moment of allocation
 
   Log_Name : String_Access;
   --  Holds the name of the heap operations log file
 
   Program_Name : String_Access;
   --  Holds the name of the user executable
 
   function Read_Next return Storage_Elmt;
   --  Reads next dynamic storage operation from the log file
 
   function Mem_Image (X : Storage_Count) return String;
   --  X is a size in storage_element. Returns a value
   --  in Megabytes, Kilobytes or Bytes as appropriate.
 
   procedure Process_Arguments;
   --  Read command line arguments
 
   procedure Usage;
   --  Prints out the option help
 
   function Gmem_Initialize (Dumpname : String) return Boolean;
   --  Opens the file represented by Dumpname and prepares it for
   --  work. Returns False if the file does not have the correct format, True
   --  otherwise.
 
   procedure Gmem_A2l_Initialize (Exename : String);
   --  Initialises the convert_addresses interface by supplying it with
   --  the name of the executable file Exename
 
   -----------------------------------
   -- HTable address --> Allocation --
   -----------------------------------
 
   type Allocation is record
      Root : Root_Id;
      Size : Storage_Count;
   end record;
 
   type Address_Range is range 0 .. 4097;
   function H (A : Integer_Address) return Address_Range;
   No_Alloc : constant Allocation := (No_Root_Id, 0);
 
   package Address_HTable is new GNAT.HTable.Simple_HTable (
     Header_Num => Address_Range,
     Element    => Allocation,
     No_Element => No_Alloc,
     Key        => Integer_Address,
     Hash       => H,
     Equal      => "=");
 
   BT_Depth   : Integer := 1;
 
   --  Some global statistics
 
   Global_Alloc_Size : Storage_Count := 0;
   --  Total number of bytes allocated during the lifetime of a program
 
   Global_High_Water_Mark : Storage_Count := 0;
   --  Largest amount of storage ever in use during the lifetime
 
   Global_Nb_Alloc : Integer := 0;
   --  Total number of allocations
 
   Global_Nb_Dealloc : Integer := 0;
   --  Total number of deallocations
 
   Nb_Root : Integer := 0;
   --  Total number of allocation roots
 
   Nb_Wrong_Deall : Integer := 0;
   --  Total number of wrong deallocations (i.e. without matching alloc)
 
   Minimum_Nb_Leaks : Integer := 1;
   --  How many unfreed allocs should be in a root for it to count as leak
 
   T0 : Duration := 0.0;
   --  The moment at which memory allocation routines initialized (should
   --  be pretty close to the moment the program started since there are
   --  always some allocations at RTL elaboration
 
   Tmp_Alloc     : Allocation;
   Dump_Log_Mode : Boolean := False;
   Quiet_Mode    : Boolean := False;
 
   ------------------------------
   -- Allocation Roots Sorting --
   ------------------------------
 
   Sort_Order : String (1 .. 3) := "nwh";
   --  This is the default order in which sorting criteria will be applied
   --  n -  Total number of unfreed allocations
   --  w -  Final watermark
   --  h -  High watermark
 
   --------------------------------
   -- GMEM functionality binding --
   --------------------------------
 
   ---------------------
   -- Gmem_Initialize --
   ---------------------
 
   function Gmem_Initialize (Dumpname : String) return Boolean is
      function Initialize (Dumpname : System.Address) return Duration;
      pragma Import (C, Initialize, "__gnat_gmem_initialize");
 
      S : aliased String := Dumpname & ASCII.NUL;
 
   begin
      T0 := Initialize (S'Address);
      return T0 > 0.0;
   end Gmem_Initialize;
 
   -------------------------
   -- Gmem_A2l_Initialize --
   -------------------------
 
   procedure Gmem_A2l_Initialize (Exename : String) is
      procedure A2l_Initialize (Exename : System.Address);
      pragma Import (C, A2l_Initialize, "__gnat_gmem_a2l_initialize");
 
      S : aliased String := Exename & ASCII.NUL;
 
   begin
      A2l_Initialize (S'Address);
   end Gmem_A2l_Initialize;
 
   ---------------
   -- Read_Next --
   ---------------
 
   function Read_Next return Storage_Elmt is
      procedure Read_Next (buf : System.Address);
      pragma Import (C, Read_Next, "__gnat_gmem_read_next");
 
      S : Storage_Elmt;
 
   begin
      Read_Next (S'Address);
      return S;
   end Read_Next;
 
   -------
   -- H --
   -------
 
   function H (A : Integer_Address) return Address_Range is
   begin
      return Address_Range (A mod Integer_Address (Address_Range'Last));
   end H;
 
   ---------------
   -- Mem_Image --
   ---------------
 
   function Mem_Image (X : Storage_Count) return String is
      Ks   : constant Storage_Count := X / 1024;
      Megs : constant Storage_Count := Ks / 1024;
      Buff : String (1 .. 7);
 
   begin
      if Megs /= 0 then
         Ada.Float_Text_IO.Put (Buff, Float (X) / 1024.0 / 1024.0, 2, 0);
         return Buff & " Megabytes";
 
      elsif Ks /= 0 then
         Ada.Float_Text_IO.Put (Buff, Float (X) / 1024.0, 2, 0);
         return Buff & " Kilobytes";
 
      else
         Ada.Integer_Text_IO.Put (Buff (1 .. 4), Integer (X));
         return Buff (1 .. 4) & " Bytes";
      end if;
   end Mem_Image;
 
   -----------
   -- Usage --
   -----------
 
   procedure Usage is
   begin
      New_Line;
      Put ("GNATMEM ");
      Put_Line (Gnat_Version_String);
      Put_Line ("Copyright 1997-2007, Free Software Foundation, Inc.");
      New_Line;
 
      Put_Line ("Usage: gnatmem switches [depth] exename");
      New_Line;
      Put_Line ("  depth    backtrace depth to take into account, default is"
                & Integer'Image (BT_Depth));
      Put_Line ("  exename  the name of the executable to be analyzed");
      New_Line;
      Put_Line ("Switches:");
      Put_Line ("  -b n     same as depth parameter");
      Put_Line ("  -i file  read the allocation log from specific file");
      Put_Line ("           default is gmem.out in the current directory");
      Put_Line ("  -m n     masks roots with less than n leaks, default is 1");
      Put_Line ("           specify 0 to see even released allocation roots");
      Put_Line ("  -q       quiet, minimum output");
      Put_Line ("  -s order sort allocation roots according to an order of");
      Put_Line ("           sort criteria");
      GNAT.OS_Lib.OS_Exit (1);
   end Usage;
 
   -----------------------
   -- Process_Arguments --
   -----------------------
 
   procedure Process_Arguments is
   begin
      --  Parse the options first
 
      loop
         case Getopt ("b: dd m: i: q s:") is
            when ASCII.NUL => exit;
 
            when 'b' =>
               begin
                  BT_Depth := Natural'Value (Parameter);
               exception
                  when Constraint_Error =>
                     Usage;
               end;
 
            when 'd' =>
               Dump_Log_Mode := True;
 
            when 'm' =>
               begin
                  Minimum_Nb_Leaks := Natural'Value (Parameter);
               exception
                  when Constraint_Error =>
                     Usage;
               end;
 
            when 'i' =>
               Log_Name := new String'(Parameter);
 
            when 'q' =>
               Quiet_Mode := True;
 
            when 's' =>
               declare
                  S : constant String (Sort_Order'Range) := Parameter;
               begin
                  for J in Sort_Order'Range loop
                     if S (J) = 'n' or else
                        S (J) = 'w' or else
                        S (J) = 'h'
                     then
                        Sort_Order (J) := S (J);
                     else
                        Put_Line ("Invalid sort criteria string.");
                        GNAT.OS_Lib.OS_Exit (1);
                     end if;
                  end loop;
               end;
 
            when others =>
               null;
         end case;
      end loop;
 
      --  Set default log file if -i hasn't been specified
 
      if Log_Name = null then
         Log_Name := new String'("gmem.out");
      end if;
 
      --  Get the optional backtrace length and program name
 
      declare
         Str1 : constant String := GNAT.Command_Line.Get_Argument;
         Str2 : constant String := GNAT.Command_Line.Get_Argument;
 
      begin
         if Str1 = "" then
            Usage;
         end if;
 
         if Str2 = "" then
            Program_Name := new String'(Str1);
         else
            BT_Depth := Natural'Value (Str1);
            Program_Name := new String'(Str2);
         end if;
 
      exception
         when Constraint_Error =>
            Usage;
      end;
 
      --  Ensure presence of executable suffix in Program_Name
 
      declare
         Suffix : String_Access := Get_Executable_Suffix;
         Tmp    : String_Access;
 
      begin
         if Suffix.all /= ""
           and then
             Program_Name.all
              (Program_Name.all'Last - Suffix.all'Length + 1 ..
                               Program_Name.all'Last) /= Suffix.all
         then
            Tmp := new String'(Program_Name.all & Suffix.all);
            Free (Program_Name);
            Program_Name := Tmp;
         end if;
 
         Free (Suffix);
 
         --  Search the executable on the path. If not found in the PATH, we
         --  default to the current directory. Otherwise, libaddr2line will
         --  fail with an error:
 
         --     (null): Bad address
 
         Tmp := Locate_Exec_On_Path (Program_Name.all);
 
         if Tmp = null then
            Tmp := new String'('.' & Directory_Separator & Program_Name.all);
         end if;
 
         Free (Program_Name);
         Program_Name := Tmp;
      end;
 
      if not Is_Regular_File (Log_Name.all) then
         Put_Line ("Couldn't find " & Log_Name.all);
         GNAT.OS_Lib.OS_Exit (1);
      end if;
 
      if not Gmem_Initialize (Log_Name.all) then
         Put_Line ("File " & Log_Name.all & " is not a gnatmem log file");
         GNAT.OS_Lib.OS_Exit (1);
      end if;
 
      if not Is_Regular_File (Program_Name.all) then
         Put_Line ("Couldn't find " & Program_Name.all);
      end if;
 
      Gmem_A2l_Initialize (Program_Name.all);
 
   exception
      when GNAT.Command_Line.Invalid_Switch =>
         Ada.Text_IO.Put_Line ("Invalid switch : "
                               & GNAT.Command_Line.Full_Switch);
         Usage;
   end Process_Arguments;
 
   --  Local variables
 
   Cur_Elmt : Storage_Elmt;
   Buff     : String (1 .. 16);
 
--  Start of processing for Gnatmem
 
begin
   Process_Arguments;
 
   if Dump_Log_Mode then
      Put_Line ("Full dump of dynamic memory operations history");
      Put_Line ("----------------------------------------------");
 
      declare
         function CTime (Clock : Address) return Address;
         pragma Import (C, CTime, "ctime");
 
         Int_T0     : Integer := Integer (T0);
         CTime_Addr : constant Address := CTime (Int_T0'Address);
 
         Buffer : String (1 .. 30);
         for Buffer'Address use CTime_Addr;
 
      begin
         Put_Line ("Log started at T0 =" & Duration'Image (T0) & " ("
                   & Buffer (1 .. 24) & ")");
      end;
   end if;
 
   --  Main loop analysing the data generated by the instrumented routines.
   --  For each allocation, the backtrace is kept and stored in a htable
   --  whose entry is the address. For each deallocation, we look for the
   --  corresponding allocation and cancel it.
 
   Main : loop
      Cur_Elmt := Read_Next;
 
      case Cur_Elmt.Elmt is
         when '*' =>
            exit Main;
 
         when 'A' =>
 
            --  Read the corresponding back trace
 
            Tmp_Alloc.Root := Read_BT (BT_Depth);
 
            if Quiet_Mode then
 
               if Nb_Alloc (Tmp_Alloc.Root) = 0 then
                  Nb_Root := Nb_Root + 1;
               end if;
 
               Set_Nb_Alloc (Tmp_Alloc.Root, Nb_Alloc (Tmp_Alloc.Root) + 1);
               Address_HTable.Set (Cur_Elmt.Address, Tmp_Alloc);
 
            elsif Cur_Elmt.Size > 0 then
 
               --  Update global counters if the allocated size is meaningful
 
               Global_Alloc_Size := Global_Alloc_Size + Cur_Elmt.Size;
               Global_Nb_Alloc   := Global_Nb_Alloc + 1;
 
               if Global_High_Water_Mark < Global_Alloc_Size then
                  Global_High_Water_Mark := Global_Alloc_Size;
               end if;
 
               --  Update the number of allocation root if this is a new one
 
               if Nb_Alloc (Tmp_Alloc.Root) = 0 then
                  Nb_Root := Nb_Root + 1;
               end if;
 
               --  Update allocation root specific counters
 
               Set_Alloc_Size (Tmp_Alloc.Root,
                 Alloc_Size (Tmp_Alloc.Root) + Cur_Elmt.Size);
 
               Set_Nb_Alloc (Tmp_Alloc.Root, Nb_Alloc (Tmp_Alloc.Root) + 1);
 
               if High_Water_Mark (Tmp_Alloc.Root) <
                                               Alloc_Size (Tmp_Alloc.Root)
               then
                  Set_High_Water_Mark (Tmp_Alloc.Root,
                    Alloc_Size (Tmp_Alloc.Root));
               end if;
 
               --  Associate this allocation root to the allocated address
 
               Tmp_Alloc.Size := Cur_Elmt.Size;
               Address_HTable.Set (Cur_Elmt.Address, Tmp_Alloc);
 
            end if;
 
         when 'D' =>
 
            --  Get the corresponding Dealloc_Size and Root
 
            Tmp_Alloc := Address_HTable.Get (Cur_Elmt.Address);
 
            if Tmp_Alloc.Root = No_Root_Id then
 
               --  There was no prior allocation at this address, something is
               --  very wrong. Mark this allocation root as problematic.
 
               Tmp_Alloc.Root := Read_BT (BT_Depth);
 
               if Nb_Alloc (Tmp_Alloc.Root) = 0 then
                  Set_Nb_Alloc (Tmp_Alloc.Root, Nb_Alloc (Tmp_Alloc.Root) - 1);
                  Nb_Wrong_Deall := Nb_Wrong_Deall + 1;
               end if;
 
            else
               --  Update global counters
 
               if not Quiet_Mode then
                  Global_Alloc_Size := Global_Alloc_Size - Tmp_Alloc.Size;
               end if;
 
               Global_Nb_Dealloc   := Global_Nb_Dealloc + 1;
 
               --  Update allocation root specific counters
 
               if not Quiet_Mode then
                  Set_Alloc_Size (Tmp_Alloc.Root,
                    Alloc_Size (Tmp_Alloc.Root) - Tmp_Alloc.Size);
               end if;
 
               Set_Nb_Alloc (Tmp_Alloc.Root, Nb_Alloc (Tmp_Alloc.Root) - 1);
 
               --  Update the number of allocation root if this one disappears
 
               if Nb_Alloc (Tmp_Alloc.Root) = 0
                 and then Minimum_Nb_Leaks > 0 then
                  Nb_Root := Nb_Root - 1;
               end if;
 
               --  Deassociate the deallocated address
 
               Address_HTable.Remove (Cur_Elmt.Address);
            end if;
 
         when others =>
            raise Program_Error;
      end case;
 
      if Dump_Log_Mode then
         case Cur_Elmt.Elmt is
            when 'A' =>
               Put ("ALLOC");
               Int_IO.Put (Buff (1 .. 16), Integer (Cur_Elmt.Address), 16);
               Put (Buff);
               Int_IO.Put (Buff (1 .. 8), Integer (Cur_Elmt.Size));
               Put (Buff (1 .. 8) & " bytes at moment T0 +");
               Put_Line (Duration'Image (Cur_Elmt.Timestamp - T0));
 
            when 'D' =>
               Put ("DEALL");
               Int_IO.Put (Buff (1 .. 16), Integer (Cur_Elmt.Address), 16);
               Put (Buff);
               Put_Line (" at moment T0 +"
                         & Duration'Image (Cur_Elmt.Timestamp - T0));
            when others =>
               raise Program_Error;
         end case;
 
         Print_BT (Tmp_Alloc.Root);
      end if;
 
   end loop Main;
 
   --  Print out general information about overall allocation
 
   if not Quiet_Mode then
      Put_Line ("Global information");
      Put_Line ("------------------");
 
      Put      ("   Total number of allocations        :");
      Ada.Integer_Text_IO.Put (Global_Nb_Alloc, 4);
      New_Line;
 
      Put      ("   Total number of deallocations      :");
      Ada.Integer_Text_IO.Put (Global_Nb_Dealloc, 4);
      New_Line;
 
      Put_Line ("   Final Water Mark (non freed mem)   :"
        & Mem_Image (Global_Alloc_Size));
      Put_Line ("   High Water Mark                    :"
        & Mem_Image (Global_High_Water_Mark));
      New_Line;
   end if;
 
   --  Print out the back traces corresponding to potential leaks in order
   --  greatest number of non-deallocated allocations.
 
   Print_Back_Traces : declare
      type Root_Array is array (Natural range <>) of Root_Id;
      type Access_Root_Array is access Root_Array;
 
      Leaks        : constant Access_Root_Array :=
                       new Root_Array (0 .. Nb_Root);
      Leak_Index   : Natural := 0;
 
      Bogus_Dealls : constant Access_Root_Array :=
                       new Root_Array (1 .. Nb_Wrong_Deall);
      Deall_Index  : Natural := 0;
      Nb_Alloc_J   : Natural := 0;
 
      procedure Move (From : Natural; To : Natural);
      function Lt (Op1, Op2 : Natural) return Boolean;
      package Root_Sort is new GNAT.Heap_Sort_G (Move, Lt);
 
      ----------
      -- Move --
      ----------
 
      procedure Move (From : Natural; To : Natural) is
      begin
         Leaks (To) := Leaks (From);
      end Move;
 
      --------
      -- Lt --
      --------
 
      function Lt (Op1, Op2 : Natural) return Boolean is
 
         function Apply_Sort_Criterion (S : Character) return Integer;
         --  Applies a specific sort criterion; returns -1, 0 or 1 if Op1 is
         --  smaller than, equal, or greater than Op2 according to criterion.
 
         --------------------------
         -- Apply_Sort_Criterion --
         --------------------------
 
         function Apply_Sort_Criterion (S : Character) return Integer is
            LOp1, LOp2 : Integer;
 
         begin
            case S is
               when 'n' =>
                  LOp1 := Nb_Alloc (Leaks (Op1));
                  LOp2 := Nb_Alloc (Leaks (Op2));
 
               when 'w' =>
                  LOp1 := Integer (Alloc_Size (Leaks (Op1)));
                  LOp2 := Integer (Alloc_Size (Leaks (Op2)));
 
               when 'h' =>
                  LOp1 := Integer (High_Water_Mark (Leaks (Op1)));
                  LOp2 := Integer (High_Water_Mark (Leaks (Op2)));
 
               when others =>
                  return 0;  --  Can't actually happen
            end case;
 
            if LOp1 < LOp2 then
               return -1;
            elsif LOp1 > LOp2 then
               return 1;
            else
               return 0;
            end if;
 
         exception
            when Constraint_Error =>
               return 0;
         end Apply_Sort_Criterion;
 
         --  Local Variables
 
         Result : Integer;
 
      --  Start of processing for Lt
 
      begin
         for S in Sort_Order'Range loop
            Result := Apply_Sort_Criterion (Sort_Order (S));
            if Result = -1 then
               return False;
            elsif Result = 1 then
               return True;
            end if;
         end loop;
         return False;
      end Lt;
 
   --  Start of processing for Print_Back_Traces
 
   begin
      --  Transfer all the relevant Roots in the Leaks and a Bogus_Deall arrays
 
      Tmp_Alloc.Root := Get_First;
      while Tmp_Alloc.Root /= No_Root_Id loop
         if Nb_Alloc (Tmp_Alloc.Root) = 0 and then Minimum_Nb_Leaks > 0 then
            null;
 
         elsif Nb_Alloc (Tmp_Alloc.Root) < 0  then
            Deall_Index := Deall_Index + 1;
            Bogus_Dealls (Deall_Index) := Tmp_Alloc.Root;
 
         else
            Leak_Index := Leak_Index + 1;
            Leaks (Leak_Index) := Tmp_Alloc.Root;
         end if;
 
         Tmp_Alloc.Root := Get_Next;
      end loop;
 
      --  Print out wrong deallocations
 
      if Nb_Wrong_Deall > 0 then
         Put_Line    ("Releasing deallocated memory at :");
         if not Quiet_Mode then
            Put_Line ("--------------------------------");
         end if;
 
         for J in  1 .. Bogus_Dealls'Last loop
            Print_BT (Bogus_Dealls (J), Short => Quiet_Mode);
            New_Line;
         end loop;
      end if;
 
      --  Print out all allocation Leaks
 
      if Leak_Index > 0 then
 
         --  Sort the Leaks so that potentially important leaks appear first
 
         Root_Sort.Sort (Leak_Index);
 
         for J in  1 .. Leak_Index loop
            Nb_Alloc_J := Nb_Alloc (Leaks (J));
 
            if Nb_Alloc_J >= Minimum_Nb_Leaks then
               if Quiet_Mode then
                  if Nb_Alloc_J = 1 then
                     Put_Line (" 1 leak at :");
                  else
                     Put_Line (Integer'Image (Nb_Alloc_J) & " leaks at :");
                  end if;
 
               else
                  Put_Line ("Allocation Root #" & Integer'Image (J));
                  Put_Line ("-------------------");
 
                  Put      (" Number of non freed allocations    :");
                  Ada.Integer_Text_IO.Put (Nb_Alloc_J, 4);
                  New_Line;
 
                  Put_Line
                    (" Final Water Mark (non freed mem)   :"
                     & Mem_Image (Alloc_Size (Leaks (J))));
 
                  Put_Line
                    (" High Water Mark                    :"
                     & Mem_Image (High_Water_Mark (Leaks (J))));
 
                  Put_Line (" Backtrace                          :");
               end if;
 
               Print_BT (Leaks (J), Short => Quiet_Mode);
               New_Line;
            end if;
         end loop;
      end if;
   end Print_Back_Traces;
end Gnatmem;