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