public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-4009] [Ada] Support gmem.out longer than 2G on 32 bit platforms
@ 2021-10-01 6:14 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-10-01 6:14 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:e0ab2003576fd34f37afbf5cd39d714b261f3f05
commit r12-4009-ge0ab2003576fd34f37afbf5cd39d714b261f3f05
Author: Dmitriy Anisimkov <anisimko@adacore.com>
Date: Fri Aug 6 17:54:28 2021 +0600
[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:
---
gcc/ada/libgnat/memtrack.adb | 127 +++++++++++++++++++++++--------------------
1 file changed, 67 insertions(+), 60 deletions(-)
diff --git a/gcc/ada/libgnat/memtrack.adb b/gcc/ada/libgnat/memtrack.adb
index e622fec1bf7..b34ac042a17 100644
--- 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;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-10-01 6:14 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-10-01 6:14 [gcc r12-4009] [Ada] Support gmem.out longer than 2G on 32 bit platforms Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).