gmem.c: Add support for timestamps on memory operations.

2007-04-20  Vasiliy Fofanov  <fofanov@adacore.com>

	* gmem.c: Add support for timestamps on memory operations.

	* memtrack.adb, gnatmem.adb: Add support for timestamps on memory
	operations (not used currently, just foundation for future
	enhancements). Add possibility to perform full dump of gmem.out file.
	(Print_Back_Traces): Declare accesses to root arrays constants since
	they aren't modified.
	(Print_Back_Traces): allocate root arrays on the heap rather than stack.

From-SVN: r125419

3 files changed, 227 insertions, 74 deletions

diff --git a/gcc/ada/gmem.c b/gcc/ada/gmem.c
index e45e12c..508d18d 100644
--- a/gcc/ada/gmem.c
+++ b/gcc/ada/gmem.c
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *         Copyright (C) 2000-2006, Free Software Foundation, Inc.          *
+ *         Copyright (C) 2000-2007, Free Software Foundation, Inc.          *
  *                                                                          *
  * 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- *
@@ -31,7 +31,7 @@
  ****************************************************************************/
 
 /*  This unit reads the allocation tracking log produced by augmented
-    __gnat_malloc and __gnat_free procedures (see file a-raise.c) and
+    __gnat_malloc and __gnat_free procedures (see file memtrack.adb) and
     provides GNATMEM tool with gdb-compliant output. The output is
     processed by GNATMEM to detect dynamic memory allocation errors.
 
@@ -43,9 +43,11 @@
       GNU/Linux x86
       Solaris (sparc and x86) (*)
       Windows 98/95/NT (x86)
+      Alpha OpenVMS
 
     (*) on these targets, the compilation must be done with -funwind-tables to
     be able to build the stack backtrace.
+
 */
 
 #include <stdio.h>
@@ -65,6 +67,7 @@ struct struct_storage_elmt {
   char   Elmt;
   void * Address;
   size_t Size;
+  long long Timestamp;
 };
 
 static void
@@ -108,14 +111,15 @@ gmem_read_backtrace (void)
   cur_tb_pos = 0;
 }
 
-/* initialize gmem feature from the dumpname file. It returns 1 if the
-   dumpname has been generated by GMEM (instrumented malloc/free) and 0 if not
-   (i.e. probably a GDB generated file).
+/* initialize gmem feature from the dumpname file. It returns t0 timestamp
+   if the dumpname has been generated by GMEM (instrumented malloc/free)
+   and 0 if not.
 */
 
-int __gnat_gmem_initialize (char *dumpname)
+long long __gnat_gmem_initialize (char *dumpname)
 {
   char header [10];
+  long long t0;
 
   gmemfile = fopen (dumpname, "rb");
   fread (header, 10, 1, gmemfile);
@@ -127,7 +131,9 @@ int __gnat_gmem_initialize (char *dumpname)
       return 0;
     }
 
-  return 1;
+  fread (&t0, sizeof (long long), 1, gmemfile);
+
+  return t0;
 }
 
 /* initialize addr2line library */
@@ -163,10 +169,12 @@ __gnat_gmem_read_next (struct struct_storage_elmt *buf)
             buf->Elmt = LOG_ALLOC;
             fread (&(buf->Address), sizeof (void *), 1, gmemfile);
             fread (&(buf->Size), sizeof (size_t), 1, gmemfile);
+            fread (&(buf->Timestamp), sizeof (long long), 1, gmemfile);
             break;
           case 'D' :
             buf->Elmt = LOG_DEALL;
             fread (&(buf->Address), sizeof (void *), 1, gmemfile);
+            fread (&(buf->Timestamp), sizeof (long long), 1, gmemfile);
             break;
           default:
             puts ("GNATMEM dump file corrupt");
diff --git a/gcc/ada/gnatmem.adb b/gcc/ada/gnatmem.adb
index d52fe00..b5c092f 100644
--- a/gcc/ada/gnatmem.adb
+++ b/gcc/ada/gnatmem.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 1997-2005, AdaCore                     --
+--                     Copyright (C) 1997-2007, 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- --
@@ -53,24 +53,25 @@
 --   execution generating memory allocation where data is collected (such as
 --   number of allocations, amount of memory allocated, high water mark, etc.)
 
-with Gnatvsn; use Gnatvsn;
-
-with Ada.Text_IO;             use Ada.Text_IO;
 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 System;                  use System;
-with System.Storage_Elements; use System.Storage_Elements;
-
+with Gnatvsn; use Gnatvsn;
 with Memroot; use Memroot;
 
 procedure Gnatmem is
 
+   package Int_IO renames Ada.Integer_Text_IO;
+
    ------------------------
    -- Other Declarations --
    ------------------------
@@ -80,13 +81,24 @@ procedure Gnatmem is
       --  *  = 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 needs a comment ???
+   --  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
 
-   Log_Name, Program_Name : String_Access;
-   --  These need comments, and should be on separate lines ???
+   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
@@ -133,18 +145,37 @@ procedure Gnatmem is
 
    BT_Depth   : Integer := 1;
 
-   --  The following need comments ???
+   --  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_Alloc_Size      : Storage_Count  := 0;
-   Global_High_Water_Mark : Storage_Count  := 0;
-   Global_Nb_Alloc        : Integer        := 0;
-   Global_Nb_Dealloc      : Integer        := 0;
-   Nb_Root                : Integer        := 0;
-   Nb_Wrong_Deall         : Integer        := 0;
-   Minimum_NB_Leaks       : Integer        := 1;
+   Global_Nb_Alloc : Integer := 0;
+   --  Total number of allocations
 
-   Tmp_Alloc   : Allocation;
-   Quiet_Mode  : Boolean := False;
+   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 --
@@ -160,16 +191,25 @@ procedure Gnatmem is
    -- GMEM functionality binding --
    --------------------------------
 
+   ---------------------
+   -- Gmem_Initialize --
+   ---------------------
+
    function Gmem_Initialize (Dumpname : String) return Boolean is
-      function Initialize (Dumpname : System.Address) return Boolean;
+      function Initialize (Dumpname : System.Address) return Duration;
       pragma Import (C, Initialize, "__gnat_gmem_initialize");
 
       S : aliased String := Dumpname & ASCII.NUL;
 
    begin
-      return Initialize (S'Address);
+      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");
@@ -180,6 +220,10 @@ procedure Gnatmem is
       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");
@@ -205,9 +249,9 @@ procedure Gnatmem is
    ---------------
 
    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);
+      Ks   : constant Storage_Count := X / 1024;
+      Megs : constant Storage_Count := Ks / 1024;
+      Buff : String (1 .. 7);
 
    begin
       if Megs /= 0 then
@@ -233,7 +277,7 @@ procedure Gnatmem is
       New_Line;
       Put ("GNATMEM ");
       Put_Line (Gnat_Version_String);
-      Put_Line ("Copyright 1997-2005, Free Software Foundation, Inc.");
+      Put_Line ("Copyright 1997-2007, Free Software Foundation, Inc.");
       New_Line;
 
       Put_Line ("Usage: gnatmem switches [depth] exename");
@@ -263,7 +307,7 @@ procedure Gnatmem is
       --  Parse the options first
 
       loop
-         case Getopt ("b: m: i: q s:") is
+         case Getopt ("b: dd m: i: q s:") is
             when ASCII.Nul => exit;
 
             when 'b' =>
@@ -274,9 +318,12 @@ procedure Gnatmem is
                      Usage;
                end;
 
+            when 'd' =>
+               Dump_Log_Mode := True;
+
             when 'm' =>
                begin
-                  Minimum_NB_Leaks := Natural'Value (Parameter);
+                  Minimum_Nb_Leaks := Natural'Value (Parameter);
                exception
                   when Constraint_Error =>
                      Usage;
@@ -291,7 +338,6 @@ procedure Gnatmem is
             when 's' =>
                declare
                   S : constant String (Sort_Order'Range) := Parameter;
-
                begin
                   for J in Sort_Order'Range loop
                      if S (J) = 'n' or else
@@ -399,13 +445,36 @@ procedure Gnatmem is
          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
@@ -420,10 +489,11 @@ begin
 
          when 'A' =>
 
-            --  Update global counters if the allocated size is meaningful
+            --  Read the corresponding back trace
+
+            Tmp_Alloc.Root := Read_BT (BT_Depth);
 
             if Quiet_Mode then
-               Tmp_Alloc.Root := Read_BT (BT_Depth);
 
                if Nb_Alloc (Tmp_Alloc.Root) = 0 then
                   Nb_Root := Nb_Root + 1;
@@ -434,6 +504,8 @@ begin
 
             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;
 
@@ -441,10 +513,6 @@ begin
                   Global_High_Water_Mark := Global_Alloc_Size;
                end if;
 
-               --  Read the corresponding back trace
-
-               Tmp_Alloc.Root := Read_BT (BT_Depth);
-
                --  Update the number of allocation root if this is a new one
 
                if Nb_Alloc (Tmp_Alloc.Root) = 0 then
@@ -470,10 +538,6 @@ begin
                Tmp_Alloc.Size := Cur_Elmt.Size;
                Address_HTable.Set (Cur_Elmt.Address, Tmp_Alloc);
 
-            --  non meaningful output, just consumes the backtrace
-
-            else
-               Tmp_Alloc.Root := Read_BT (BT_Depth);
             end if;
 
          when 'D' =>
@@ -485,7 +549,7 @@ begin
             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
+               --  very wrong. Mark this allocation root as problematic.
 
                Tmp_Alloc.Root := Read_BT (BT_Depth);
 
@@ -512,14 +576,14 @@ begin
 
                Set_Nb_Alloc (Tmp_Alloc.Root, Nb_Alloc (Tmp_Alloc.Root) - 1);
 
-               --  update the number of allocation root if this one disappear
+               --  Update the number of allocation root if this one disappears
 
                if Nb_Alloc (Tmp_Alloc.Root) = 0
-                 and then Minimum_NB_Leaks > 0 then
+                 and then Minimum_Nb_Leaks > 0 then
                   Nb_Root := Nb_Root - 1;
                end if;
 
-               --  De-associate the deallocated address
+               --  Deassociate the deallocated address
 
                Address_HTable.Remove (Cur_Elmt.Address);
             end if;
@@ -527,6 +591,30 @@ begin
          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
@@ -551,33 +639,51 @@ begin
    end if;
 
    --  Print out the back traces corresponding to potential leaks in order
-   --  greatest number of non-deallocated allocations
+   --  greatest number of non-deallocated allocations.
 
    Print_Back_Traces : declare
       type Root_Array is array (Natural range <>) of Root_Id;
-      Leaks   : Root_Array (0 .. Nb_Root);
+      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 : Root_Array (1 .. Nb_Wrong_Deall);
+      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);
+      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
+         --  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' =>
@@ -603,11 +709,14 @@ begin
             else
                return 0;
             end if;
+
          exception
             when Constraint_Error =>
                return 0;
          end Apply_Sort_Criterion;
 
+         --  Local Variables
+
          Result : Integer;
 
       --  Start of processing for Lt
@@ -627,12 +736,11 @@ begin
    --  Start of processing for Print_Back_Traces
 
    begin
-      --  Transfer all the relevant Roots in the Leaks and a
-      --  Bogus_Deall arrays
+      --  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
+         if Nb_Alloc (Tmp_Alloc.Root) = 0 and then Minimum_Nb_Leaks > 0 then
             null;
 
          elsif Nb_Alloc (Tmp_Alloc.Root) < 0  then
@@ -663,15 +771,16 @@ begin
 
       --  Print out all allocation Leaks
 
-      if Nb_Root > 0 then
+      if Leak_Index > 0 then
 
          --  Sort the Leaks so that potentially important leaks appear first
 
-         Root_Sort.Sort (Nb_Root);
+         Root_Sort.Sort (Leak_Index);
 
-         for J in  1 .. Leaks'Last loop
+         for J in  1 .. Leak_Index loop
             Nb_Alloc_J := Nb_Alloc (Leaks (J));
-            if Nb_Alloc_J >= Minimum_NB_Leaks then
+
+            if Nb_Alloc_J >= Minimum_Nb_Leaks then
                if Quiet_Mode then
                   if Nb_Alloc_J = 1 then
                      Put_Line (" 1 leak at :");
diff --git a/gcc/ada/memtrack.adb b/gcc/ada/memtrack.adb
index ce61395..ad5c900 100644
--- a/gcc/ada/memtrack.adb
+++ b/gcc/ada/memtrack.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2001-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- 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- --
@@ -64,6 +64,12 @@
 --    Irix
 --    Solaris
 --    Tru64
+--    Alpha OpenVMS
+
+--  NOTE FOR FUTURE PLATFORMS SUPPORT: It is assumed that type Duration is
+--  64 bit. If the need arises to support architectures where this assumption
+--  is incorrect, it will require changing the way timestamps of allocation
+--  events are recorded.
 
 pragma Source_File_Name (System.Memory, Body_File_Name => "memtrack.adb");
 
@@ -72,6 +78,7 @@ with System.Soft_Links;
 with System.Traceback;
 with System.Traceback_Entries;
 with GNAT.IO;
+with System.OS_Primitives;
 
 package body System.Memory is
 
@@ -140,6 +147,9 @@ package body System.Memory is
    Gmemfile : File_Ptr;
    --  Global C file pointer to the allocation log
 
+   Needs_Init : Boolean := True;
+   --  Reset after first call to Gmem_Initialize
+
    procedure Gmem_Initialize;
    --  Initialization routine; opens the file and writes a header string. This
    --  header string is used as a magic-tag to know if the .out file is to be
@@ -157,6 +167,7 @@ package body System.Memory is
    function Alloc (Size : size_t) return System.Address is
       Result      : aliased System.Address;
       Actual_Size : aliased size_t := Size;
+      Timestamp   : aliased Duration;
 
    begin
       if Size = size_t'Last then
@@ -184,13 +195,19 @@ package body System.Memory is
 
          First_Call := False;
 
-         Gmem_Initialize;
+         if Needs_Init then
+            Gmem_Initialize;
+         end if;
+
+         Timestamp := System.OS_Primitives.Clock;
          Call_Chain (Tracebk'Address, Max_Call_Stack, Num_Calls,
                      Skip_Frames => 2);
          fputc (Character'Pos ('A'), Gmemfile);
          fwrite (Result'Address, Address_Size, 1, Gmemfile);
          fwrite (Actual_Size'Address, size_t'Max_Size_In_Storage_Elements, 1,
                  Gmemfile);
+         fwrite (Timestamp'Address, Duration'Max_Size_In_Storage_Elements, 1,
+                 Gmemfile);
          fwrite (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements, 1,
                  Gmemfile);
 
@@ -219,9 +236,6 @@ package body System.Memory is
    -- Finalize --
    --------------
 
-   Needs_Init : Boolean := True;
-   --  Reset after first call to Gmem_Initialize
-
    procedure Finalize is
    begin
       if not Needs_Init then
@@ -234,7 +248,8 @@ package body System.Memory is
    ----------
 
    procedure Free (Ptr : System.Address) is
-      Addr : aliased constant System.Address := Ptr;
+      Addr      : aliased constant System.Address := Ptr;
+      Timestamp : aliased Duration;
 
    begin
       Lock_Task.all;
@@ -247,11 +262,17 @@ package body System.Memory is
 
          First_Call := False;
 
-         Gmem_Initialize;
+         if Needs_Init then
+            Gmem_Initialize;
+         end if;
+
          Call_Chain (Tracebk'Address, Max_Call_Stack, Num_Calls,
                      Skip_Frames => 2);
+         Timestamp := System.OS_Primitives.Clock;
          fputc (Character'Pos ('D'), Gmemfile);
          fwrite (Addr'Address, Address_Size, 1, Gmemfile);
+         fwrite (Timestamp'Address, Duration'Max_Size_In_Storage_Elements, 1,
+                 Gmemfile);
          fwrite (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements, 1,
                  Gmemfile);
 
@@ -276,9 +297,13 @@ package body System.Memory is
    ---------------------
 
    procedure Gmem_Initialize is
+      Timestamp : aliased Duration;
+
    begin
       if Needs_Init then
          Needs_Init := False;
+         System.OS_Primitives.Initialize;
+         Timestamp := System.OS_Primitives.Clock;
          Gmemfile := fopen (Gmemfname, "wb" & ASCII.NUL);
 
          if Gmemfile = System.Null_Address then
@@ -287,6 +312,8 @@ package body System.Memory is
          end if;
 
          fwrite ("GMEM DUMP" & ASCII.LF, 10, 1, Gmemfile);
+         fwrite (Timestamp'Address, Duration'Max_Size_In_Storage_Elements, 1,
+                 Gmemfile);
       end if;
    end Gmem_Initialize;
 
@@ -295,10 +322,12 @@ package body System.Memory is
    -------------
 
    function Realloc
-     (Ptr : System.Address; Size : size_t) return System.Address
+     (Ptr  : System.Address;
+      Size : size_t) return System.Address
    is
-      Addr : aliased constant System.Address := Ptr;
-      Result : aliased System.Address;
+      Addr      : aliased constant System.Address := Ptr;
+      Result    : aliased System.Address;
+      Timestamp : aliased Duration;
 
    begin
       --  For the purposes of allocations logging, we treat realloc as a free
@@ -317,11 +346,16 @@ package body System.Memory is
 
          --  We first log deallocation call
 
-         Gmem_Initialize;
+         if Needs_Init then
+            Gmem_Initialize;
+         end if;
          Call_Chain (Tracebk'Address, Max_Call_Stack, Num_Calls,
                      Skip_Frames => 2);
+         Timestamp := System.OS_Primitives.Clock;
          fputc (Character'Pos ('D'), Gmemfile);
          fwrite (Addr'Address, Address_Size, 1, Gmemfile);
+         fwrite (Timestamp'Address, Duration'Max_Size_In_Storage_Elements, 1,
+                 Gmemfile);
          fwrite (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements, 1,
                  Gmemfile);
 
@@ -343,6 +377,8 @@ package body System.Memory is
          fwrite (Result'Address, Address_Size, 1, Gmemfile);
          fwrite (Size'Address, size_t'Max_Size_In_Storage_Elements, 1,
                  Gmemfile);
+         fwrite (Timestamp'Address, Duration'Max_Size_In_Storage_Elements, 1,
+                 Gmemfile);
          fwrite (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements, 1,
                  Gmemfile);