[Ada] Support gmem.out longer than 2G on 32 bit platforms

gcc/ada/

	* libgnat/memtrack.adb (Putc): New routine wrapped around fputc
	with error check.
	(Write): New routine wrapped around fwrite with error check.
	Remove bound functions fopen, fwrite, fputs, fclose, OS_Exit.
	Use the similar routines from System.CRTL and System.OS_Lib.

diff --git a/gcc/ada/libgnat/memtrack.adb b/gcc/ada/libgnat/memtrack.adb
index e622fec..b34ac04 100644 (file)
--- a/gcc/ada/libgnat/memtrack.adb
+++ b/gcc/ada/libgnat/memtrack.adb
@@ -69,10 +69,13 @@
 pragma Source_File_Name (System.Memory, Body_File_Name => "memtrack.adb");
 
 with Ada.Exceptions;
+with GNAT.IO;
+
 with System.Soft_Links;
 with System.Traceback;
 with System.Traceback_Entries;
-with GNAT.IO;
+with System.CRTL;
+with System.OS_Lib;
 with System.OS_Primitives;
 
 package body System.Memory is
@@ -93,30 +96,14 @@ package body System.Memory is
      (Ptr : System.Address; Size : size_t) return System.Address;
    pragma Import (C, c_realloc, "realloc");
 
-   subtype File_Ptr is System.Address;
-
-   function fopen (Path : String; Mode : String) return File_Ptr;
-   pragma Import (C, fopen);
-
-   procedure OS_Exit (Status : Integer);
-   pragma Import (C, OS_Exit, "__gnat_os_exit");
-   pragma No_Return (OS_Exit);
-
    In_Child_After_Fork : Integer;
    pragma Import (C, In_Child_After_Fork, "__gnat_in_child_after_fork");
 
-   procedure fwrite
-     (Ptr    : System.Address;
-      Size   : size_t;
-      Nmemb  : size_t;
-      Stream : File_Ptr);
-   pragma Import (C, fwrite);
+   subtype File_Ptr is CRTL.FILEs;
 
-   procedure fputc (C : Integer; Stream : File_Ptr);
-   pragma Import (C, fputc);
+   procedure Write (Ptr : System.Address; Size : size_t);
 
-   procedure fclose (Stream : File_Ptr);
-   pragma Import (C, fclose);
+   procedure Putc (Char : Character);
 
    procedure Finalize;
    pragma Export (C, Finalize, "__gnat_finalize");
@@ -210,20 +197,17 @@ package body System.Memory is
          Timestamp := System.OS_Primitives.Clock;
          Call_Chain
            (Tracebk, 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);
+         Putc ('A');
+         Write (Result'Address, Address_Size);
+         Write (Actual_Size'Address, size_t'Max_Size_In_Storage_Elements);
+         Write (Timestamp'Address, Duration'Max_Size_In_Storage_Elements);
+         Write (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements);
 
          for J in Tracebk'First .. Tracebk'First + Num_Calls - 1 loop
             declare
                Ptr : System.Address := PC_For (Tracebk (J));
             begin
-               fwrite (Ptr'Address, Address_Size, 1, Gmemfile);
+               Write (Ptr'Address, Address_Size);
             end;
          end loop;
 
@@ -246,8 +230,8 @@ package body System.Memory is
 
    procedure Finalize is
    begin
-      if not Needs_Init then
-         fclose (Gmemfile);
+      if not Needs_Init and then CRTL.fclose (Gmemfile) /= 0 then
+         Put_Line ("gmem close error: " & OS_Lib.Errno_Message);
       end if;
    end Finalize;
 
@@ -275,18 +259,16 @@ package body System.Memory is
          Call_Chain
            (Tracebk, 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);
+         Putc ('D');
+         Write (Addr'Address, Address_Size);
+         Write (Timestamp'Address, Duration'Max_Size_In_Storage_Elements);
+         Write (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements);
 
          for J in Tracebk'First .. Tracebk'First + Num_Calls - 1 loop
             declare
                Ptr : System.Address := PC_For (Tracebk (J));
             begin
-               fwrite (Ptr'Address, Address_Size, 1, Gmemfile);
+               Write (Ptr'Address, Address_Size);
             end;
          end loop;
 
@@ -304,29 +286,41 @@ package body System.Memory is
 
    procedure Gmem_Initialize is
       Timestamp : aliased Duration;
-
+      File_Mode : constant String := "wb" & ASCII.NUL;
    begin
       if Needs_Init then
          Needs_Init := False;
          System.OS_Primitives.Initialize;
          Timestamp := System.OS_Primitives.Clock;
-         Gmemfile := fopen (Gmemfname, "wb" & ASCII.NUL);
+         Gmemfile := CRTL.fopen (Gmemfname'Address, File_Mode'Address);
 
          if Gmemfile = System.Null_Address then
             Put_Line ("Couldn't open gnatmem log file for writing");
-            OS_Exit (255);
+            OS_Lib.OS_Exit (255);
          end if;
 
          declare
             S : constant String := "GMEM DUMP" & ASCII.LF;
          begin
-            fwrite (S'Address, S'Length, 1, Gmemfile);
-            fwrite (Timestamp'Address, Duration'Max_Size_In_Storage_Elements,
-                    1, Gmemfile);
+            Write (S'Address, S'Length);
+            Write (Timestamp'Address, Duration'Max_Size_In_Storage_Elements);
          end;
       end if;
    end Gmem_Initialize;
 
+   ----------
+   -- Putc --
+   ----------
+
+   procedure Putc (Char : Character) is
+      C : constant Integer := Character'Pos (Char);
+
+   begin
+      if CRTL.fputc (C, Gmemfile) /= C then
+         Put_Line ("gmem fputc error: " & OS_Lib.Errno_Message);
+      end if;
+   end Putc;
+
    -------------
    -- Realloc --
    -------------
@@ -360,18 +354,16 @@ package body System.Memory is
          Call_Chain
            (Tracebk, 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);
+         Putc ('D');
+         Write (Addr'Address, Address_Size);
+         Write (Timestamp'Address, Duration'Max_Size_In_Storage_Elements);
+         Write (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements);
 
          for J in Tracebk'First .. Tracebk'First + Num_Calls - 1 loop
             declare
                Ptr : System.Address := PC_For (Tracebk (J));
             begin
-               fwrite (Ptr'Address, Address_Size, 1, Gmemfile);
+               Write (Ptr'Address, Address_Size);
             end;
          end loop;
 
@@ -381,20 +373,17 @@ package body System.Memory is
 
          --   Log allocation call using the same backtrace
 
-         fputc (Character'Pos ('A'), Gmemfile);
-         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);
+         Putc ('A');
+         Write (Result'Address, Address_Size);
+         Write (Size'Address, size_t'Max_Size_In_Storage_Elements);
+         Write (Timestamp'Address, Duration'Max_Size_In_Storage_Elements);
+         Write (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements);
 
          for J in Tracebk'First .. Tracebk'First + Num_Calls - 1 loop
             declare
                Ptr : System.Address := PC_For (Tracebk (J));
             begin
-               fwrite (Ptr'Address, Address_Size, 1, Gmemfile);
+               Write (Ptr'Address, Address_Size);
             end;
          end loop;
 
@@ -411,4 +400,22 @@ package body System.Memory is
       return Result;
    end Realloc;
 
+   -----------
+   -- Write --
+   -----------
+
+   procedure Write (Ptr : System.Address; Size : size_t) is
+      function fwrite
+        (buffer : System.Address;
+         size   : size_t;
+         count  : size_t;
+         stream : File_Ptr) return size_t;
+      pragma Import (C, fwrite);
+
+   begin
+      if fwrite (Ptr, Size, 1, Gmemfile) /= 1 then
+         Put_Line ("gmem fwrite error: " & OS_Lib.Errno_Message);
+      end if;
+   end Write;
+
 end System.Memory;