gcc/ada/gnatmem.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              G N A T M E M                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --           Copyright (C) 1997-2005, Ada Core Technologies, Inc.           --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, USA.                                                      --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 --  GNATMEM is a utility that tracks memory leaks. It is based on a simple
  28 --  idea:
  29
  30 --      - Read the allocation log generated by the application linked using
  31 --        instrumented memory allocation and dealocation (see memtrack.adb for
  32 --        this circuitry). To get access to this functionality, the application
  33 --        must be relinked with library libgmem.a:
  34
  35 --            $ gnatmake my_prog -largs -lgmem
  36
  37 --        The running my_prog will produce a file named gmem.out that will be
  38 --        parsed by gnatmem.
  39
  40 --      - Record a reference to the allocated memory on each allocation call
  41
  42 --      - Suppress this reference on deallocation
  43
  44 --      - At the end of the program, remaining references are potential leaks.
  45 --        sort them out the best possible way in order to locate the root of
  46 --        the leak.
  47
  48 --   This capability is not supported on all platforms, please refer to
  49 --   memtrack.adb for further information.
  50
  51 --   In order to help finding out the real leaks,  the notion of "allocation
  52 --   root" is defined. An allocation root is a specific point in the program
  53 --   execution generating memory allocation where data is collected (such as
  54 --   number of allocations, amount of memory allocated, high water mark, etc.)
  55
  56 with Gnatvsn; use Gnatvsn;
  57
  58 with Ada.Text_IO;             use Ada.Text_IO;
  59 with Ada.Float_Text_IO;
  60 with Ada.Integer_Text_IO;
  61
  62 with GNAT.Command_Line;       use GNAT.Command_Line;
  63 with GNAT.Heap_Sort_G;
  64 with GNAT.OS_Lib;             use GNAT.OS_Lib;
  65 with GNAT.HTable;             use GNAT.HTable;
  66
  67 with System;                  use System;
  68 with System.Storage_Elements; use System.Storage_Elements;
  69
  70 with Memroot; use Memroot;
  71
  72 procedure Gnatmem is
  73
  74    ------------------------
  75    -- Other Declarations --
  76    ------------------------
  77
  78    type Storage_Elmt is record
  79       Elmt : Character;
  80       --  *  = End of log file
  81       --  A  = found a ALLOC mark in the log
  82       --  D  = found a DEALL mark in the log
  83       Address : Integer_Address;
  84       Size    : Storage_Count;
  85    end record;
  86    --  This needs a comment ???
  87
  88    Log_Name, Program_Name : String_Access;
  89    --  These need comments, and should be on separate lines ???
  90
  91    function Read_Next return Storage_Elmt;
  92    --  Reads next dynamic storage operation from the log file
  93
  94    function Mem_Image (X : Storage_Count) return String;
  95    --  X is a size in storage_element. Returns a value
  96    --  in Megabytes, Kilobytes or Bytes as appropriate.
  97
  98    procedure Process_Arguments;
  99    --  Read command line arguments
 100
 101    procedure Usage;
 102    --  Prints out the option help
 103
 104    function Gmem_Initialize (Dumpname : String) return Boolean;
 105    --  Opens the file represented by Dumpname and prepares it for
 106    --  work. Returns False if the file does not have the correct format, True
 107    --  otherwise.
 108
 109    procedure Gmem_A2l_Initialize (Exename : String);
 110    --  Initialises the convert_addresses interface by supplying it with
 111    --  the name of the executable file Exename
 112
 113    -----------------------------------
 114    -- HTable address --> Allocation --
 115    -----------------------------------
 116
 117    type Allocation is record
 118       Root : Root_Id;
 119       Size : Storage_Count;
 120    end record;
 121
 122    type Address_Range is range 0 .. 4097;
 123    function H (A : Integer_Address) return Address_Range;
 124    No_Alloc : constant Allocation := (No_Root_Id, 0);
 125
 126    package Address_HTable is new GNAT.HTable.Simple_HTable (
 127      Header_Num => Address_Range,
 128      Element    => Allocation,
 129      No_Element => No_Alloc,
 130      Key        => Integer_Address,
 131      Hash       => H,
 132      Equal      => "=");
 133
 134    BT_Depth   : Integer := 1;
 135
 136    --  The following need comments ???
 137
 138    Global_Alloc_Size      : Storage_Count  := 0;
 139    Global_High_Water_Mark : Storage_Count  := 0;
 140    Global_Nb_Alloc        : Integer        := 0;
 141    Global_Nb_Dealloc      : Integer        := 0;
 142    Nb_Root                : Integer        := 0;
 143    Nb_Wrong_Deall         : Integer        := 0;
 144    Minimum_NB_Leaks       : Integer        := 1;
 145
 146    Tmp_Alloc   : Allocation;
 147    Quiet_Mode  : Boolean := False;
 148
 149    ------------------------------
 150    -- Allocation Roots Sorting --
 151    ------------------------------
 152
 153    Sort_Order : String (1 .. 3) := "nwh";
 154    --  This is the default order in which sorting criteria will be applied
 155    --  n -  Total number of unfreed allocations
 156    --  w -  Final watermark
 157    --  h -  High watermark
 158
 159    --------------------------------
 160    -- GMEM functionality binding --
 161    --------------------------------
 162
 163    function Gmem_Initialize (Dumpname : String) return Boolean is
 164       function Initialize (Dumpname : System.Address) return Boolean;
 165       pragma Import (C, Initialize, "__gnat_gmem_initialize");
 166
 167       S : aliased String := Dumpname & ASCII.NUL;
 168
 169    begin
 170       return Initialize (S'Address);
 171    end Gmem_Initialize;
 172
 173    procedure Gmem_A2l_Initialize (Exename : String) is
 174       procedure A2l_Initialize (Exename : System.Address);
 175       pragma Import (C, A2l_Initialize, "__gnat_gmem_a2l_initialize");
 176
 177       S : aliased String := Exename & ASCII.NUL;
 178
 179    begin
 180       A2l_Initialize (S'Address);
 181    end Gmem_A2l_Initialize;
 182
 183    function Read_Next return Storage_Elmt is
 184       procedure Read_Next (buf : System.Address);
 185       pragma Import (C, Read_Next, "__gnat_gmem_read_next");
 186
 187       S : Storage_Elmt;
 188
 189    begin
 190       Read_Next (S'Address);
 191       return S;
 192    end Read_Next;
 193
 194    -------
 195    -- H --
 196    -------
 197
 198    function H (A : Integer_Address) return Address_Range is
 199    begin
 200       return Address_Range (A mod Integer_Address (Address_Range'Last));
 201    end H;
 202
 203    ---------------
 204    -- Mem_Image --
 205    ---------------
 206
 207    function Mem_Image (X : Storage_Count) return String is
 208       Ks    : constant Storage_Count := X / 1024;
 209       Megs  : constant Storage_Count := Ks / 1024;
 210       Buff  : String (1 .. 7);
 211
 212    begin
 213       if Megs /= 0 then
 214          Ada.Float_Text_IO.Put (Buff, Float (X) / 1024.0 / 1024.0, 2, 0);
 215          return Buff & " Megabytes";
 216
 217       elsif Ks /= 0 then
 218          Ada.Float_Text_IO.Put (Buff, Float (X) / 1024.0, 2, 0);
 219          return Buff & " Kilobytes";
 220
 221       else
 222          Ada.Integer_Text_IO.Put (Buff (1 .. 4), Integer (X));
 223          return Buff (1 .. 4) & " Bytes";
 224       end if;
 225    end Mem_Image;
 226
 227    -----------
 228    -- Usage --
 229    -----------
 230
 231    procedure Usage is
 232    begin
 233       New_Line;
 234       Put ("GNATMEM ");
 235       Put_Line (Gnat_Version_String);
 236       Put_Line ("Copyright 1997-2005 Free Software Foundation, Inc.");
 237       New_Line;
 238
 239       Put_Line ("Usage: gnatmem switches [depth] exename");
 240       New_Line;
 241       Put_Line ("  depth    backtrace depth to take into account, default is"
 242                 & Integer'Image (BT_Depth));
 243       Put_Line ("  exename  the name of the executable to be analyzed");
 244       New_Line;
 245       Put_Line ("Switches:");
 246       Put_Line ("  -b n     same as depth parameter");
 247       Put_Line ("  -i file  read the allocation log from specific file");
 248       Put_Line ("           default is gmem.out in the current directory");
 249       Put_Line ("  -m n     masks roots with less than n leaks, default is 1");
 250       Put_Line ("           specify 0 to see even released allocation roots");
 251       Put_Line ("  -q       quiet, minimum output");
 252       Put_Line ("  -s order sort allocation roots according to an order of");
 253       Put_Line ("           sort criteria");
 254       GNAT.OS_Lib.OS_Exit (1);
 255    end Usage;
 256
 257    -----------------------
 258    -- Process_Arguments --
 259    -----------------------
 260
 261    procedure Process_Arguments is
 262    begin
 263       --  Parse the options first
 264
 265       loop
 266          case Getopt ("b: m: i: q s:") is
 267             when ASCII.Nul => exit;
 268
 269             when 'b' =>
 270                begin
 271                   BT_Depth := Natural'Value (Parameter);
 272                exception
 273                   when Constraint_Error =>
 274                      Usage;
 275                end;
 276
 277             when 'm' =>
 278                begin
 279                   Minimum_NB_Leaks := Natural'Value (Parameter);
 280                exception
 281                   when Constraint_Error =>
 282                      Usage;
 283                end;
 284
 285             when 'i' =>
 286                Log_Name := new String'(Parameter);
 287
 288             when 'q' =>
 289                Quiet_Mode := True;
 290
 291             when 's' =>
 292                declare
 293                   S : constant String (Sort_Order'Range) := Parameter;
 294
 295                begin
 296                   for J in Sort_Order'Range loop
 297                      if S (J) = 'n' or else
 298                         S (J) = 'w' or else
 299                         S (J) = 'h'
 300                      then
 301                         Sort_Order (J) := S (J);
 302                      else
 303                         Put_Line ("Invalid sort criteria string.");
 304                         GNAT.OS_Lib.OS_Exit (1);
 305                      end if;
 306                   end loop;
 307                end;
 308
 309             when others =>
 310                null;
 311          end case;
 312       end loop;
 313
 314       --  Set default log file if -i hasn't been specified
 315
 316       if Log_Name = null then
 317          Log_Name := new String'("gmem.out");
 318       end if;
 319
 320       --  Get the optional backtrace length and program name
 321
 322       declare
 323          Str1 : constant String := GNAT.Command_Line.Get_Argument;
 324          Str2 : constant String := GNAT.Command_Line.Get_Argument;
 325
 326       begin
 327          if Str1 = "" then
 328             Usage;
 329          end if;
 330
 331          if Str2 = "" then
 332             Program_Name := new String'(Str1);
 333          else
 334             BT_Depth := Natural'Value (Str1);
 335             Program_Name := new String'(Str2);
 336          end if;
 337
 338       exception
 339          when Constraint_Error =>
 340             Usage;
 341       end;
 342
 343       --  Ensure presence of executable suffix in Program_Name
 344
 345       declare
 346          Suffix : String_Access := Get_Executable_Suffix;
 347          Tmp    : String_Access;
 348
 349       begin
 350          if Suffix.all /= ""
 351            and then
 352              Program_Name.all
 353               (Program_Name.all'Last - Suffix.all'Length + 1 ..
 354                                Program_Name.all'Last) /= Suffix.all
 355          then
 356             Tmp := new String'(Program_Name.all & Suffix.all);
 357             Free (Program_Name);
 358             Program_Name := Tmp;
 359          end if;
 360
 361          Free (Suffix);
 362
 363          --  Search the executable on the path. If not found in the PATH, we
 364          --  default to the current directory. Otherwise, libaddr2line will
 365          --  fail with an error:
 366
 367          --     (null): Bad address
 368
 369          Tmp := Locate_Exec_On_Path (Program_Name.all);
 370
 371          if Tmp = null then
 372             Tmp := new String'('.' & Directory_Separator & Program_Name.all);
 373          end if;
 374
 375          Free (Program_Name);
 376          Program_Name := Tmp;
 377       end;
 378
 379       if not Is_Regular_File (Log_Name.all) then
 380          Put_Line ("Couldn't find " & Log_Name.all);
 381          GNAT.OS_Lib.OS_Exit (1);
 382       end if;
 383
 384       if not Gmem_Initialize (Log_Name.all) then
 385          Put_Line ("File " & Log_Name.all & " is not a gnatmem log file");
 386          GNAT.OS_Lib.OS_Exit (1);
 387       end if;
 388
 389       if not Is_Regular_File (Program_Name.all) then
 390          Put_Line ("Couldn't find " & Program_Name.all);
 391       end if;
 392
 393       Gmem_A2l_Initialize (Program_Name.all);
 394
 395    exception
 396       when GNAT.Command_Line.Invalid_Switch =>
 397          Ada.Text_IO.Put_Line ("Invalid switch : "
 398                                & GNAT.Command_Line.Full_Switch);
 399          Usage;
 400    end Process_Arguments;
 401
 402    Cur_Elmt : Storage_Elmt;
 403
 404 --  Start of processing for Gnatmem
 405
 406 begin
 407    Process_Arguments;
 408
 409    --  Main loop analysing the data generated by the instrumented routines.
 410    --  For each allocation, the backtrace is kept and stored in a htable
 411    --  whose entry is the address. For each deallocation, we look for the
 412    --  corresponding allocation and cancel it.
 413
 414    Main : loop
 415       Cur_Elmt := Read_Next;
 416
 417       case Cur_Elmt.Elmt is
 418          when '*' =>
 419             exit Main;
 420
 421          when 'A' =>
 422
 423             --  Update global counters if the allocated size is meaningful
 424
 425             if Quiet_Mode then
 426                Tmp_Alloc.Root := Read_BT (BT_Depth);
 427
 428                if Nb_Alloc (Tmp_Alloc.Root) = 0 then
 429                   Nb_Root := Nb_Root + 1;
 430                end if;
 431
 432                Set_Nb_Alloc (Tmp_Alloc.Root, Nb_Alloc (Tmp_Alloc.Root) + 1);
 433                Address_HTable.Set (Cur_Elmt.Address, Tmp_Alloc);
 434
 435             elsif Cur_Elmt.Size > 0 then
 436
 437                Global_Alloc_Size := Global_Alloc_Size + Cur_Elmt.Size;
 438                Global_Nb_Alloc   := Global_Nb_Alloc + 1;
 439
 440                if Global_High_Water_Mark < Global_Alloc_Size then
 441                   Global_High_Water_Mark := Global_Alloc_Size;
 442                end if;
 443
 444                --  Read the corresponding back trace
 445
 446                Tmp_Alloc.Root := Read_BT (BT_Depth);
 447
 448                --  Update the number of allocation root if this is a new one
 449
 450                if Nb_Alloc (Tmp_Alloc.Root) = 0 then
 451                   Nb_Root := Nb_Root + 1;
 452                end if;
 453
 454                --  Update allocation root specific counters
 455
 456                Set_Alloc_Size (Tmp_Alloc.Root,
 457                  Alloc_Size (Tmp_Alloc.Root) + Cur_Elmt.Size);
 458
 459                Set_Nb_Alloc (Tmp_Alloc.Root, Nb_Alloc (Tmp_Alloc.Root) + 1);
 460
 461                if High_Water_Mark (Tmp_Alloc.Root) <
 462                                                Alloc_Size (Tmp_Alloc.Root)
 463                then
 464                   Set_High_Water_Mark (Tmp_Alloc.Root,
 465                     Alloc_Size (Tmp_Alloc.Root));
 466                end if;
 467
 468                --  Associate this allocation root to the allocated address
 469
 470                Tmp_Alloc.Size := Cur_Elmt.Size;
 471                Address_HTable.Set (Cur_Elmt.Address, Tmp_Alloc);
 472
 473             --  non meaningful output, just consumes the backtrace
 474
 475             else
 476                Tmp_Alloc.Root := Read_BT (BT_Depth);
 477             end if;
 478
 479          when 'D' =>
 480
 481             --  Get the corresponding Dealloc_Size and Root
 482
 483             Tmp_Alloc := Address_HTable.Get (Cur_Elmt.Address);
 484
 485             if Tmp_Alloc.Root = No_Root_Id then
 486
 487                --  There was no prior allocation at this address, something is
 488                --  very wrong. Mark this allocation root as problematic
 489
 490                Tmp_Alloc.Root := Read_BT (BT_Depth);
 491
 492                if Nb_Alloc (Tmp_Alloc.Root) = 0 then
 493                   Set_Nb_Alloc (Tmp_Alloc.Root, Nb_Alloc (Tmp_Alloc.Root) - 1);
 494                   Nb_Wrong_Deall := Nb_Wrong_Deall + 1;
 495                end if;
 496
 497             else
 498                --  Update global counters
 499
 500                if not Quiet_Mode then
 501                   Global_Alloc_Size := Global_Alloc_Size - Tmp_Alloc.Size;
 502                end if;
 503
 504                Global_Nb_Dealloc   := Global_Nb_Dealloc + 1;
 505
 506                --  Update allocation root specific counters
 507
 508                if not Quiet_Mode then
 509                   Set_Alloc_Size (Tmp_Alloc.Root,
 510                     Alloc_Size (Tmp_Alloc.Root) - Tmp_Alloc.Size);
 511                end if;
 512
 513                Set_Nb_Alloc (Tmp_Alloc.Root, Nb_Alloc (Tmp_Alloc.Root) - 1);
 514
 515                --  update the number of allocation root if this one disappear
 516
 517                if Nb_Alloc (Tmp_Alloc.Root) = 0
 518                  and then Minimum_NB_Leaks > 0 then
 519                   Nb_Root := Nb_Root - 1;
 520                end if;
 521
 522                --  De-associate the deallocated address
 523
 524                Address_HTable.Remove (Cur_Elmt.Address);
 525             end if;
 526
 527          when others =>
 528             raise Program_Error;
 529       end case;
 530    end loop Main;
 531
 532    --  Print out general information about overall allocation
 533
 534    if not Quiet_Mode then
 535       Put_Line ("Global information");
 536       Put_Line ("------------------");
 537
 538       Put      ("   Total number of allocations        :");
 539       Ada.Integer_Text_IO.Put (Global_Nb_Alloc, 4);
 540       New_Line;
 541
 542       Put      ("   Total number of deallocations      :");
 543       Ada.Integer_Text_IO.Put (Global_Nb_Dealloc, 4);
 544       New_Line;
 545
 546       Put_Line ("   Final Water Mark (non freed mem)   :"
 547         & Mem_Image (Global_Alloc_Size));
 548       Put_Line ("   High Water Mark                    :"
 549         & Mem_Image (Global_High_Water_Mark));
 550       New_Line;
 551    end if;
 552
 553    --  Print out the back traces corresponding to potential leaks in order
 554    --  greatest number of non-deallocated allocations
 555
 556    Print_Back_Traces : declare
 557       type Root_Array is array (Natural range <>) of Root_Id;
 558       Leaks   : Root_Array (0 .. Nb_Root);
 559       Leak_Index   : Natural := 0;
 560
 561       Bogus_Dealls : Root_Array (1 .. Nb_Wrong_Deall);
 562       Deall_Index  : Natural := 0;
 563       Nb_Alloc_J   : Natural := 0;
 564
 565       procedure Move (From : Natural; To : Natural);
 566       function  Lt (Op1, Op2 : Natural) return Boolean;
 567       package   Root_Sort is new GNAT.Heap_Sort_G (Move, Lt);
 568
 569       procedure Move (From : Natural; To : Natural) is
 570       begin
 571          Leaks (To) := Leaks (From);
 572       end Move;
 573
 574       function Lt (Op1, Op2 : Natural) return Boolean is
 575          function Apply_Sort_Criterion (S : Character) return Integer;
 576          --  Applies a specific sort criterion; returns -1, 0 or 1 if Op1 is
 577          --  smaller than, equal, or greater than Op2 according to criterion
 578
 579          function Apply_Sort_Criterion (S : Character) return Integer is
 580             LOp1, LOp2 : Integer;
 581          begin
 582             case S is
 583                when 'n' =>
 584                   LOp1 := Nb_Alloc (Leaks (Op1));
 585                   LOp2 := Nb_Alloc (Leaks (Op2));
 586
 587                when 'w' =>
 588                   LOp1 := Integer (Alloc_Size (Leaks (Op1)));
 589                   LOp2 := Integer (Alloc_Size (Leaks (Op2)));
 590
 591                when 'h' =>
 592                   LOp1 := Integer (High_Water_Mark (Leaks (Op1)));
 593                   LOp2 := Integer (High_Water_Mark (Leaks (Op2)));
 594
 595                when others =>
 596                   return 0;  --  Can't actually happen
 597             end case;
 598
 599             if LOp1 < LOp2 then
 600                return -1;
 601             elsif LOp1 > LOp2 then
 602                return 1;
 603             else
 604                return 0;
 605             end if;
 606          exception
 607             when Constraint_Error =>
 608                return 0;
 609          end Apply_Sort_Criterion;
 610
 611          Result : Integer;
 612
 613       --  Start of processing for Lt
 614
 615       begin
 616          for S in Sort_Order'Range loop
 617             Result := Apply_Sort_Criterion (Sort_Order (S));
 618             if Result = -1 then
 619                return False;
 620             elsif Result = 1 then
 621                return True;
 622             end if;
 623          end loop;
 624          return False;
 625       end Lt;
 626
 627    --  Start of processing for Print_Back_Traces
 628
 629    begin
 630       --  Transfer all the relevant Roots in the Leaks and a
 631       --  Bogus_Deall arrays
 632
 633       Tmp_Alloc.Root := Get_First;
 634       while Tmp_Alloc.Root /= No_Root_Id loop
 635          if Nb_Alloc (Tmp_Alloc.Root) = 0 and then Minimum_NB_Leaks > 0 then
 636             null;
 637
 638          elsif Nb_Alloc (Tmp_Alloc.Root) < 0  then
 639             Deall_Index := Deall_Index + 1;
 640             Bogus_Dealls (Deall_Index) := Tmp_Alloc.Root;
 641
 642          else
 643             Leak_Index := Leak_Index + 1;
 644             Leaks (Leak_Index) := Tmp_Alloc.Root;
 645          end if;
 646
 647          Tmp_Alloc.Root := Get_Next;
 648       end loop;
 649
 650       --  Print out wrong deallocations
 651
 652       if Nb_Wrong_Deall > 0 then
 653          Put_Line    ("Releasing deallocated memory at :");
 654          if not Quiet_Mode then
 655             Put_Line ("--------------------------------");
 656          end if;
 657
 658          for J in  1 .. Bogus_Dealls'Last loop
 659             Print_BT (Bogus_Dealls (J), Short => Quiet_Mode);
 660             New_Line;
 661          end loop;
 662       end if;
 663
 664       --  Print out all allocation Leaks
 665
 666       if Nb_Root > 0 then
 667
 668          --  Sort the Leaks so that potentially important leaks appear first
 669
 670          Root_Sort.Sort (Nb_Root);
 671
 672          for J in  1 .. Leaks'Last loop
 673             Nb_Alloc_J := Nb_Alloc (Leaks (J));
 674             if Nb_Alloc_J >= Minimum_NB_Leaks then
 675                if Quiet_Mode then
 676                   if Nb_Alloc_J = 1 then
 677                      Put_Line (" 1 leak at :");
 678                   else
 679                      Put_Line (Integer'Image (Nb_Alloc_J) & " leaks at :");
 680                   end if;
 681
 682                else
 683                   Put_Line ("Allocation Root #" & Integer'Image (J));
 684                   Put_Line ("-------------------");
 685
 686                   Put      (" Number of non freed allocations    :");
 687                   Ada.Integer_Text_IO.Put (Nb_Alloc_J, 4);
 688                   New_Line;
 689
 690                   Put_Line
 691                     (" Final Water Mark (non freed mem)   :"
 692                      & Mem_Image (Alloc_Size (Leaks (J))));
 693
 694                   Put_Line
 695                     (" High Water Mark                    :"
 696                      & Mem_Image (High_Water_Mark (Leaks (J))));
 697
 698                   Put_Line (" Backtrace                          :");
 699                end if;
 700
 701                Print_BT (Leaks (J), Short => Quiet_Mode);
 702                New_Line;
 703             end if;
 704          end loop;
 705       end if;
 706    end Print_Back_Traces;
 707 end Gnatmem;