From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1914) id 8B1533857C60; Fri, 1 Oct 2021 06:14:51 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 8B1533857C60 MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Pierre-Marie de Rodat To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-4009] [Ada] Support gmem.out longer than 2G on 32 bit platforms X-Act-Checkin: gcc X-Git-Author: Dmitriy Anisimkov X-Git-Refname: refs/heads/master X-Git-Oldrev: 6732c4035d54dbc543e067aa1886c88939b0fed5 X-Git-Newrev: e0ab2003576fd34f37afbf5cd39d714b261f3f05 Message-Id: <20211001061451.8B1533857C60@sourceware.org> Date: Fri, 1 Oct 2021 06:14:51 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Fri, 01 Oct 2021 06:14:51 -0000 https://gcc.gnu.org/g:e0ab2003576fd34f37afbf5cd39d714b261f3f05 commit r12-4009-ge0ab2003576fd34f37afbf5cd39d714b261f3f05 Author: Dmitriy Anisimkov 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;