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