mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-03-25 10:20:43 +08:00
g-debpoo.ads, [...] (Free_Physically.Free_Blocks): Use the absolute value of Header.Block_Size when...
2007-04-20 Vincent Celier <celier@adacore.com> Emmanuel Briot <briot@adacore.com> Olivier Hainque <hainque@adacore.com> * g-debpoo.ads, g-debpoo.adb (Free_Physically.Free_Blocks): Use the absolute value of Header.Block_Size when displaying the freed physical memory in traces. (Allocate): Compute Storage_Address using Integer_Address, not Storage_Offset, because the range of Storage_Offset may not be large enough. (Configure): New parameter Low_Level_Traces (Allocate, Deallocation, Free_Physically): Added low-level traces (Configure): new parameter Errors_To_Stdout. (Output_File): new subprogram (Deallocate, Dereference): Send error messages to the proper stream (Print_Pool, Print_Info_Stdout): Make sure the output goes to stdout, as documented. Previous code would send it to the current output file defined in GNAT.IO, which might not be stdout (Is_Valid): Adjust comment to mention that a positive reply means that Header_Of may be used to retrieve the allocation header associated with the subprogram Storage address argument. Return False early if this address argument is misaligned. From-SVN: r125415
This commit is contained in:
Vincent Celier
Arnaud Charlet
parent
fbe627afbd
commit
f38df0e116
gcc/ada
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-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- --
|
||||
@ -223,21 +223,27 @@ package body GNAT.Debug_Pools is
|
||||
-- including, an address between Ignored_Frame_Start .. Ignored_Frame_End
|
||||
-- are ignored.
|
||||
|
||||
function Output_File (Pool : Debug_Pool) return File_Type;
|
||||
pragma Inline (Output_File);
|
||||
-- Returns file_type on which error messages have to be generated for Pool
|
||||
|
||||
procedure Put_Line
|
||||
(Depth : Natural;
|
||||
(File : File_Type;
|
||||
Depth : Natural;
|
||||
Traceback : Tracebacks_Array_Access;
|
||||
Ignored_Frame_Start : System.Address := System.Null_Address;
|
||||
Ignored_Frame_End : System.Address := System.Null_Address);
|
||||
-- Print Traceback to Standard_Output. If Traceback is null, print the
|
||||
-- call_chain at the current location, up to Depth levels, ignoring all
|
||||
-- addresses up to the first one in the range
|
||||
-- Ignored_Frame_Start .. Ignored_Frame_End
|
||||
-- Print Traceback to File. If Traceback is null, print the call_chain
|
||||
-- at the current location, up to Depth levels, ignoring all addresses
|
||||
-- up to the first one in the range:
|
||||
-- Ignored_Frame_Start .. Ignored_Frame_End
|
||||
|
||||
package Validity is
|
||||
function Is_Valid (Storage : System.Address) return Boolean;
|
||||
pragma Inline (Is_Valid);
|
||||
-- Return True if Storage is an address that the debug pool has under
|
||||
-- its control.
|
||||
-- Return True if Storage is the address of a block that the debug pool
|
||||
-- has under its control, in which case Header_Of may be used to access
|
||||
-- the associated allocation header.
|
||||
|
||||
procedure Set_Valid (Storage : System.Address; Value : Boolean);
|
||||
pragma Inline (Set_Valid);
|
||||
@ -356,12 +362,26 @@ package body GNAT.Debug_Pools is
|
||||
return Header (1 + Result mod Integer_Address (Header'Last));
|
||||
end Hash;
|
||||
|
||||
-----------------
|
||||
-- Output_File --
|
||||
-----------------
|
||||
|
||||
function Output_File (Pool : Debug_Pool) return File_Type is
|
||||
begin
|
||||
if Pool.Errors_To_Stdout then
|
||||
return Standard_Output;
|
||||
else
|
||||
return Standard_Error;
|
||||
end if;
|
||||
end Output_File;
|
||||
|
||||
--------------
|
||||
-- Put_Line --
|
||||
--------------
|
||||
|
||||
procedure Put_Line
|
||||
(Depth : Natural;
|
||||
(File : File_Type;
|
||||
Depth : Natural;
|
||||
Traceback : Tracebacks_Array_Access;
|
||||
Ignored_Frame_Start : System.Address := System.Null_Address;
|
||||
Ignored_Frame_End : System.Address := System.Null_Address)
|
||||
@ -376,9 +396,9 @@ package body GNAT.Debug_Pools is
|
||||
procedure Print (Tr : Tracebacks_Array) is
|
||||
begin
|
||||
for J in Tr'Range loop
|
||||
Put ("0x" & Address_Image (PC_For (Tr (J))) & ' ');
|
||||
Put (File, "0x" & Address_Image (PC_For (Tr (J))) & ' ');
|
||||
end loop;
|
||||
Put (ASCII.LF);
|
||||
Put (File, ASCII.LF);
|
||||
end Print;
|
||||
|
||||
-- Start of processing for Put_Line
|
||||
@ -555,21 +575,35 @@ package body GNAT.Debug_Pools is
|
||||
|
||||
function Is_Valid (Storage : System.Address) return Boolean is
|
||||
Int_Storage : constant Integer_Address := To_Integer (Storage);
|
||||
Block_Number : constant Integer_Address :=
|
||||
Int_Storage / Memory_Chunk_Size;
|
||||
Ptr : constant Validity_Bits_Ref :=
|
||||
Validy_Htable.Get (Block_Number);
|
||||
Offset : constant Integer_Address :=
|
||||
(Int_Storage - (Block_Number * Memory_Chunk_Size)) /
|
||||
Default_Alignment;
|
||||
Bit : constant Byte :=
|
||||
2 ** Natural (Offset mod System.Storage_Unit);
|
||||
|
||||
begin
|
||||
if Ptr = No_Validity_Bits then
|
||||
-- The pool only returns addresses aligned on Default_Alignment so
|
||||
-- anything off cannot be a valid block address and we can return
|
||||
-- early in this case. We actually have to since our datastructures
|
||||
-- map validity bits for such aligned addresses only.
|
||||
|
||||
if Int_Storage mod Default_Alignment /= 0 then
|
||||
return False;
|
||||
else
|
||||
return (Ptr (Offset / System.Storage_Unit) and Bit) /= 0;
|
||||
end if;
|
||||
|
||||
declare
|
||||
Block_Number : constant Integer_Address :=
|
||||
Int_Storage / Memory_Chunk_Size;
|
||||
Ptr : constant Validity_Bits_Ref :=
|
||||
Validy_Htable.Get (Block_Number);
|
||||
Offset : constant Integer_Address :=
|
||||
(Int_Storage -
|
||||
(Block_Number * Memory_Chunk_Size)) /
|
||||
Default_Alignment;
|
||||
Bit : constant Byte :=
|
||||
2 ** Natural (Offset mod System.Storage_Unit);
|
||||
begin
|
||||
if Ptr = No_Validity_Bits then
|
||||
return False;
|
||||
else
|
||||
return (Ptr (Offset / System.Storage_Unit) and Bit) /= 0;
|
||||
end if;
|
||||
end;
|
||||
end Is_Valid;
|
||||
|
||||
---------------
|
||||
@ -673,10 +707,13 @@ package body GNAT.Debug_Pools is
|
||||
end;
|
||||
|
||||
Storage_Address :=
|
||||
System.Null_Address + Default_Alignment
|
||||
* (((P.all'Address + Default_Alignment - 1) - System.Null_Address)
|
||||
/ Default_Alignment)
|
||||
+ Header_Offset;
|
||||
To_Address
|
||||
(Default_Alignment *
|
||||
((To_Integer (P.all'Address) + Default_Alignment - 1)
|
||||
/ Default_Alignment)
|
||||
+ Integer_Address (Header_Offset));
|
||||
-- Computation is done in Integer_Address, not Storage_Offset, because
|
||||
-- the range of Storage_Offset may not be large enough.
|
||||
|
||||
pragma Assert ((Storage_Address - System.Null_Address)
|
||||
mod Default_Alignment = 0);
|
||||
@ -721,6 +758,20 @@ package body GNAT.Debug_Pools is
|
||||
|
||||
Set_Valid (Storage_Address, True);
|
||||
|
||||
if Pool.Low_Level_Traces then
|
||||
Put (Output_File (Pool),
|
||||
"info: Allocated"
|
||||
& Storage_Count'Image (Size_In_Storage_Elements)
|
||||
& " bytes at 0x" & Address_Image (Storage_Address)
|
||||
& " (physically:"
|
||||
& Storage_Count'Image (Local_Storage_Array'Length)
|
||||
& " bytes at 0x" & Address_Image (P.all'Address)
|
||||
& "), at ");
|
||||
Put_Line (Output_File (Pool), Pool.Stack_Trace_Depth, null,
|
||||
Allocate_Label'Address,
|
||||
Code_Address_For_Deallocate_End);
|
||||
end if;
|
||||
|
||||
-- Update internal data
|
||||
|
||||
Pool.Allocated :=
|
||||
@ -894,6 +945,17 @@ package body GNAT.Debug_Pools is
|
||||
end;
|
||||
|
||||
Next := Header.Next;
|
||||
|
||||
if Pool.Low_Level_Traces then
|
||||
Put_Line
|
||||
(Output_File (Pool),
|
||||
"info: Freeing physical memory "
|
||||
& Storage_Count'Image
|
||||
((abs Header.Block_Size) + Minimum_Allocation)
|
||||
& " bytes at 0x"
|
||||
& Address_Image (Header.Allocation_Address));
|
||||
end if;
|
||||
|
||||
System.Memory.Free (Header.Allocation_Address);
|
||||
Set_Valid (Tmp, False);
|
||||
|
||||
@ -1065,8 +1127,9 @@ package body GNAT.Debug_Pools is
|
||||
if Pool.Raise_Exceptions then
|
||||
raise Freeing_Not_Allocated_Storage;
|
||||
else
|
||||
Put ("error: Freeing not allocated storage, at ");
|
||||
Put_Line (Pool.Stack_Trace_Depth, null,
|
||||
Put (Output_File (Pool),
|
||||
"error: Freeing not allocated storage, at ");
|
||||
Put_Line (Output_File (Pool), Pool.Stack_Trace_Depth, null,
|
||||
Deallocate_Label'Address,
|
||||
Code_Address_For_Deallocate_End);
|
||||
end if;
|
||||
@ -1076,21 +1139,53 @@ package body GNAT.Debug_Pools is
|
||||
if Pool.Raise_Exceptions then
|
||||
raise Freeing_Deallocated_Storage;
|
||||
else
|
||||
Put ("error: Freeing already deallocated storage, at ");
|
||||
Put_Line (Pool.Stack_Trace_Depth, null,
|
||||
Put (Output_File (Pool),
|
||||
"error: Freeing already deallocated storage, at ");
|
||||
Put_Line (Output_File (Pool), Pool.Stack_Trace_Depth, null,
|
||||
Deallocate_Label'Address,
|
||||
Code_Address_For_Deallocate_End);
|
||||
Put (" Memory already deallocated at ");
|
||||
Put_Line (0, To_Traceback (Header.Dealloc_Traceback).Traceback);
|
||||
Put (" Memory was allocated at ");
|
||||
Put_Line (0, Header.Alloc_Traceback.Traceback);
|
||||
Put (Output_File (Pool), " Memory already deallocated at ");
|
||||
Put_Line
|
||||
(Output_File (Pool), 0,
|
||||
To_Traceback (Header.Dealloc_Traceback).Traceback);
|
||||
Put (Output_File (Pool), " Memory was allocated at ");
|
||||
Put_Line (Output_File (Pool), 0, Header.Alloc_Traceback.Traceback);
|
||||
end if;
|
||||
|
||||
else
|
||||
-- Some sort of codegen problem or heap corruption caused the
|
||||
-- Size_In_Storage_Elements to be wrongly computed.
|
||||
-- The code below is all based on the assumption that Header.all
|
||||
-- is not corrupted, such that the error is non-fatal.
|
||||
|
||||
if Header.Block_Size /= Size_In_Storage_Elements then
|
||||
Put_Line (Output_File (Pool),
|
||||
"error: Deallocate size "
|
||||
& Storage_Count'Image (Size_In_Storage_Elements)
|
||||
& " does not match allocate size "
|
||||
& Storage_Count'Image (Header.Block_Size));
|
||||
end if;
|
||||
|
||||
if Pool.Low_Level_Traces then
|
||||
Put (Output_File (Pool),
|
||||
"info: Deallocated"
|
||||
& Storage_Count'Image (Size_In_Storage_Elements)
|
||||
& " bytes at 0x" & Address_Image (Storage_Address)
|
||||
& " (physically"
|
||||
& Storage_Count'Image (Header.Block_Size + Minimum_Allocation)
|
||||
& " bytes at 0x" & Address_Image (Header.Allocation_Address)
|
||||
& "), at ");
|
||||
Put_Line (Output_File (Pool), Pool.Stack_Trace_Depth, null,
|
||||
Deallocate_Label'Address,
|
||||
Code_Address_For_Deallocate_End);
|
||||
Put (Output_File (Pool), " Memory was allocated at ");
|
||||
Put_Line (Output_File (Pool), 0, Header.Alloc_Traceback.Traceback);
|
||||
end if;
|
||||
|
||||
-- Remove this block from the list of used blocks
|
||||
|
||||
Previous :=
|
||||
To_Address (Header_Of (Storage_Address).Dealloc_Traceback);
|
||||
To_Address (Header.Dealloc_Traceback);
|
||||
|
||||
if Previous = System.Null_Address then
|
||||
Pool.First_Used_Block := Header_Of (Pool.First_Used_Block).Next;
|
||||
@ -1101,12 +1196,11 @@ package body GNAT.Debug_Pools is
|
||||
end if;
|
||||
|
||||
else
|
||||
Header_Of (Previous).Next := Header_Of (Storage_Address).Next;
|
||||
Header_Of (Previous).Next := Header.Next;
|
||||
|
||||
if Header_Of (Storage_Address).Next /= System.Null_Address then
|
||||
if Header.Next /= System.Null_Address then
|
||||
Header_Of
|
||||
(Header_Of (Storage_Address).Next).Dealloc_Traceback :=
|
||||
To_Address (Previous);
|
||||
(Header.Next).Dealloc_Traceback := To_Address (Previous);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
@ -1122,15 +1216,14 @@ package body GNAT.Debug_Pools is
|
||||
Deallocate_Label'Address,
|
||||
Code_Address_For_Deallocate_End)),
|
||||
Next => System.Null_Address,
|
||||
Block_Size => -Size_In_Storage_Elements);
|
||||
Block_Size => -Header.Block_Size);
|
||||
|
||||
if Pool.Reset_Content_On_Free then
|
||||
Set_Dead_Beef (Storage_Address, Size_In_Storage_Elements);
|
||||
Set_Dead_Beef (Storage_Address, -Header.Block_Size);
|
||||
end if;
|
||||
|
||||
Pool.Logically_Deallocated :=
|
||||
Pool.Logically_Deallocated +
|
||||
Byte_Count (Size_In_Storage_Elements);
|
||||
Pool.Logically_Deallocated + Byte_Count (-Header.Block_Size);
|
||||
|
||||
-- Link this free block with the others (at the end of the list, so
|
||||
-- that we can start releasing the older blocks first later on).
|
||||
@ -1201,8 +1294,9 @@ package body GNAT.Debug_Pools is
|
||||
if Pool.Raise_Exceptions then
|
||||
raise Accessing_Not_Allocated_Storage;
|
||||
else
|
||||
Put ("error: Accessing not allocated storage, at ");
|
||||
Put_Line (Pool.Stack_Trace_Depth, null,
|
||||
Put (Output_File (Pool),
|
||||
"error: Accessing not allocated storage, at ");
|
||||
Put_Line (Output_File (Pool), Pool.Stack_Trace_Depth, null,
|
||||
Dereference_Label'Address,
|
||||
Code_Address_For_Dereference_End);
|
||||
end if;
|
||||
@ -1214,15 +1308,20 @@ package body GNAT.Debug_Pools is
|
||||
if Pool.Raise_Exceptions then
|
||||
raise Accessing_Deallocated_Storage;
|
||||
else
|
||||
Put ("error: Accessing deallocated storage, at ");
|
||||
Put (Output_File (Pool),
|
||||
"error: Accessing deallocated storage, at ");
|
||||
Put_Line
|
||||
(Pool.Stack_Trace_Depth, null,
|
||||
(Output_File (Pool), Pool.Stack_Trace_Depth, null,
|
||||
Dereference_Label'Address,
|
||||
Code_Address_For_Dereference_End);
|
||||
Put (" First deallocation at ");
|
||||
Put_Line (0, To_Traceback (Header.Dealloc_Traceback).Traceback);
|
||||
Put (" Initial allocation at ");
|
||||
Put_Line (0, Header.Alloc_Traceback.Traceback);
|
||||
Put (Output_File (Pool), " First deallocation at ");
|
||||
Put_Line
|
||||
(Output_File (Pool),
|
||||
0, To_Traceback (Header.Dealloc_Traceback).Traceback);
|
||||
Put (Output_File (Pool), " Initial allocation at ");
|
||||
Put_Line
|
||||
(Output_File (Pool),
|
||||
0, Header.Alloc_Traceback.Traceback);
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
@ -1441,7 +1540,9 @@ package body GNAT.Debug_Pools is
|
||||
Minimum_To_Free : SSC := Default_Min_Freed;
|
||||
Reset_Content_On_Free : Boolean := Default_Reset_Content;
|
||||
Raise_Exceptions : Boolean := Default_Raise_Exceptions;
|
||||
Advanced_Scanning : Boolean := Default_Advanced_Scanning)
|
||||
Advanced_Scanning : Boolean := Default_Advanced_Scanning;
|
||||
Errors_To_Stdout : Boolean := Default_Errors_To_Stdout;
|
||||
Low_Level_Traces : Boolean := Default_Low_Level_Traces)
|
||||
is
|
||||
begin
|
||||
Pool.Stack_Trace_Depth := Stack_Trace_Depth;
|
||||
@ -1450,6 +1551,8 @@ package body GNAT.Debug_Pools is
|
||||
Pool.Raise_Exceptions := Raise_Exceptions;
|
||||
Pool.Minimum_To_Free := Minimum_To_Free;
|
||||
Pool.Advanced_Scanning := Advanced_Scanning;
|
||||
Pool.Errors_To_Stdout := Errors_To_Stdout;
|
||||
Pool.Low_Level_Traces := Low_Level_Traces;
|
||||
end Configure;
|
||||
|
||||
----------------
|
||||
@ -1467,23 +1570,27 @@ package body GNAT.Debug_Pools is
|
||||
-- instead of passing the value of my_var
|
||||
|
||||
if A = System.Null_Address then
|
||||
Put_Line ("Memory not under control of the storage pool");
|
||||
Put_Line
|
||||
(Standard_Output, "Memory not under control of the storage pool");
|
||||
return;
|
||||
end if;
|
||||
|
||||
if not Valid then
|
||||
Put_Line ("Memory not under control of the storage pool");
|
||||
Put_Line
|
||||
(Standard_Output, "Memory not under control of the storage pool");
|
||||
|
||||
else
|
||||
Header := Header_Of (Storage);
|
||||
Put_Line ("0x" & Address_Image (A)
|
||||
Put_Line (Standard_Output, "0x" & Address_Image (A)
|
||||
& " allocated at:");
|
||||
Put_Line (0, Header.Alloc_Traceback.Traceback);
|
||||
Put_Line (Standard_Output, 0, Header.Alloc_Traceback.Traceback);
|
||||
|
||||
if To_Traceback (Header.Dealloc_Traceback) /= null then
|
||||
Put_Line ("0x" & Address_Image (A)
|
||||
Put_Line (Standard_Output, "0x" & Address_Image (A)
|
||||
& " logically freed memory, deallocated at:");
|
||||
Put_Line (0, To_Traceback (Header.Dealloc_Traceback).Traceback);
|
||||
Put_Line
|
||||
(Standard_Output, 0,
|
||||
To_Traceback (Header.Dealloc_Traceback).Traceback);
|
||||
end if;
|
||||
end if;
|
||||
end Print_Pool;
|
||||
@ -1498,9 +1605,35 @@ package body GNAT.Debug_Pools is
|
||||
Display_Slots : Boolean := False;
|
||||
Display_Leaks : Boolean := False)
|
||||
is
|
||||
procedure Stdout_Put (S : String);
|
||||
procedure Stdout_Put_Line (S : String);
|
||||
-- Wrappers for Put and Put_Line that ensure we always write to stdout
|
||||
-- instead of the current output file defined in GNAT.IO.
|
||||
|
||||
procedure Internal is new Print_Info
|
||||
(Put_Line => GNAT.IO.Put_Line,
|
||||
Put => GNAT.IO.Put);
|
||||
(Put_Line => Stdout_Put_Line,
|
||||
Put => Stdout_Put);
|
||||
|
||||
----------------
|
||||
-- Stdout_Put --
|
||||
----------------
|
||||
|
||||
procedure Stdout_Put (S : String) is
|
||||
begin
|
||||
Put_Line (Standard_Output, S);
|
||||
end Stdout_Put;
|
||||
|
||||
---------------------
|
||||
-- Stdout_Put_Line --
|
||||
---------------------
|
||||
|
||||
procedure Stdout_Put_Line (S : String) is
|
||||
begin
|
||||
Put_Line (Standard_Output, S);
|
||||
end Stdout_Put_Line;
|
||||
|
||||
-- Start of processing for Print_Info_Stdout
|
||||
|
||||
begin
|
||||
Internal (Pool, Cumulate, Display_Slots, Display_Leaks);
|
||||
end Print_Info_Stdout;
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-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- --
|
||||
@ -36,7 +36,7 @@
|
||||
-- The goal of this debug pool is to detect incorrect uses of memory
|
||||
-- (multiple deallocations, access to invalid memory,...). Errors are reported
|
||||
-- in one of two ways: either by immediately raising an exception, or by
|
||||
-- printing a message on standard output.
|
||||
-- printing a message on standard output or standard error.
|
||||
|
||||
-- You need to instrument your code to use this package: for each access type
|
||||
-- you want to monitor, you need to add a clause similar to:
|
||||
@ -102,6 +102,8 @@ package GNAT.Debug_Pools is
|
||||
Default_Raise_Exceptions : constant Boolean := True;
|
||||
Default_Advanced_Scanning : constant Boolean := False;
|
||||
Default_Min_Freed : constant SSC := 0;
|
||||
Default_Errors_To_Stdout : constant Boolean := True;
|
||||
Default_Low_Level_Traces : constant Boolean := False;
|
||||
-- The above values are constants used for the parameters to Configure
|
||||
-- if not overridden in the call. See description of Configure for full
|
||||
-- details on these parameters. If these defaults are not satisfactory,
|
||||
@ -114,7 +116,9 @@ package GNAT.Debug_Pools is
|
||||
Minimum_To_Free : SSC := Default_Min_Freed;
|
||||
Reset_Content_On_Free : Boolean := Default_Reset_Content;
|
||||
Raise_Exceptions : Boolean := Default_Raise_Exceptions;
|
||||
Advanced_Scanning : Boolean := Default_Advanced_Scanning);
|
||||
Advanced_Scanning : Boolean := Default_Advanced_Scanning;
|
||||
Errors_To_Stdout : Boolean := Default_Errors_To_Stdout;
|
||||
Low_Level_Traces : Boolean := Default_Low_Level_Traces);
|
||||
-- Subprogram used to configure the debug pool.
|
||||
--
|
||||
-- Stack_Trace_Depth. This parameter controls the maximum depth of stack
|
||||
@ -143,7 +147,8 @@ package GNAT.Debug_Pools is
|
||||
--
|
||||
-- Raise_Exceptions: If true, the exceptions below will be raised every
|
||||
-- time an error is detected. If you set this to False, then the action
|
||||
-- is to generate output on standard error, noting the errors, but to
|
||||
-- is to generate output on standard error or standard output, depending
|
||||
-- on Errors_To_Stdout, noting the errors, but to
|
||||
-- keep running if possible (of course if storage is badly damaged, this
|
||||
-- attempt may fail. This helps to detect more than one error in a run.
|
||||
--
|
||||
@ -153,6 +158,17 @@ package GNAT.Debug_Pools is
|
||||
-- Note that this algorithm is approximate, and it is recommended
|
||||
-- that you set Minimum_To_Free to a non-zero value to save time.
|
||||
--
|
||||
-- Errors_To_Stdout: Errors messages will be displayed on stdout if
|
||||
-- this parameter is True, or to stderr otherwise.
|
||||
--
|
||||
-- Low_Level_Traces: Traces all allocation and deallocations on the
|
||||
-- stream specified by Errors_To_Stdout. This can be used for
|
||||
-- post-processing by your own application, or to debug the
|
||||
-- debug_pool itself. The output indicates the size of the allocated
|
||||
-- block both as requested by the application and as physically
|
||||
-- allocated to fit the additional information needed by the debug
|
||||
-- pool.
|
||||
--
|
||||
-- All instantiations of this pool use the same internal tables. However,
|
||||
-- they do not store the same amount of information for the tracebacks,
|
||||
-- and they have different counters for maximum logically freed memory.
|
||||
@ -289,6 +305,8 @@ private
|
||||
Raise_Exceptions : Boolean := Default_Raise_Exceptions;
|
||||
Minimum_To_Free : SSC := Default_Min_Freed;
|
||||
Advanced_Scanning : Boolean := Default_Advanced_Scanning;
|
||||
Errors_To_Stdout : Boolean := Default_Errors_To_Stdout;
|
||||
Low_Level_Traces : Boolean := Default_Low_Level_Traces;
|
||||
|
||||
Allocated : Byte_Count := 0;
|
||||
-- Total number of bytes allocated in this pool
|
||||
@ -297,7 +315,7 @@ private
|
||||
-- Total number of bytes logically deallocated in this pool. This is the
|
||||
-- memory that the application has released, but that the pool has not
|
||||
-- yet physically released through a call to free(), to detect later
|
||||
-- accesed to deallocated memory.
|
||||
-- accessed to deallocated memory.
|
||||
|
||||
Physically_Deallocated : Byte_Count := 0;
|
||||
-- Total number of bytes that were free()-ed
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user