C stream fopen function opens file for size no more than 2G by default
on 32 bit platforms. Use fopen and other stream functions from
System.CRTL to overcome this limit.
Tested on x86_64-pc-linux-gnu, committed on trunk
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
--- 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;
