OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

g-debpoo.adb (Set_Valid): Use Integer_Address instead of Storage_Offset to avoid wrap around causing... 

2005-11-14  Robert Dewar  <dewar@adacore.com>

	* g-debpoo.adb (Set_Valid): Use Integer_Address instead of
	Storage_Offset to avoid wrap around causing invalid results.

From-SVN: r106981
This commit is contained in:
Robert Dewar 2005-11-15 14:59:11 +01:00 committed by Arnaud Charlet
parent 2edf9900de
commit 2989065ea6
1 changed files with 87 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

152
gcc/ada/g-debpoo.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005, 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- --
@ -47,7 +47,7 @@ with Ada.Unchecked_Conversion;
package body GNAT.Debug_Pools is
Default_Alignment : constant Storage_Offset := Standard'Maximum_Alignment;
Default_Alignment : constant := Standard'Maximum_Alignment;
-- Alignment used for the memory chunks returned by Allocate. Using this
-- value garantees that this alignment will be compatible with all types
-- and at the same time makes it easy to find the location of the extra
@ -63,14 +63,15 @@ package body GNAT.Debug_Pools is
-- Maximum number of levels that will be ignored in backtraces. This is so
-- that we still have enough significant levels in the tracebacks returned
-- to the user.
--
-- The value 10 is chosen as being greater than the maximum callgraph
-- in this package. Its actual value is not really relevant, as long as it
-- is high enough to make sure we still have enough frames to return to
-- the user after we have hidden the frames internal to this package.
-----------------------
-- Tracebacks_Htable --
-----------------------
---------------------------
-- Back Trace Hash Table --
---------------------------
-- This package needs to store one set of tracebacks for each allocation
-- point (when was it allocated or deallocated). This would use too much
@ -103,19 +104,28 @@ package body GNAT.Debug_Pools is
Next : Traceback_Htable_Elem_Ptr;
end record;
-- Subprograms used for the Backtrace_Htable instantiation
procedure Set_Next
(E : Traceback_Htable_Elem_Ptr;
Next : Traceback_Htable_Elem_Ptr);
pragma Inline (Set_Next);
function Next
(E : Traceback_Htable_Elem_Ptr)
return Traceback_Htable_Elem_Ptr;
(E : Traceback_Htable_Elem_Ptr) return Traceback_Htable_Elem_Ptr;
pragma Inline (Next);
function Get_Key
(E : Traceback_Htable_Elem_Ptr)
return Tracebacks_Array_Access;
(E : Traceback_Htable_Elem_Ptr) return Tracebacks_Array_Access;
pragma Inline (Get_Key);
function Hash (T : Tracebacks_Array_Access) return Header;
pragma Inline (Hash);
function Equal (K1, K2 : Tracebacks_Array_Access) return Boolean;
pragma Inline (Set_Next, Next, Get_Key, Hash);
-- Subprograms required for instantiation of the htable. See GNAT.HTable.
-- Why is this not inlined???
-- The hash table for back traces
package Backtrace_Htable is new GNAT.HTable.Static_HTable
(Header_Num => Header,
@ -136,24 +146,26 @@ package body GNAT.Debug_Pools is
type Allocation_Header;
type Allocation_Header_Access is access Allocation_Header;
-- The following record stores extra information that needs to be
-- memorized for each block allocated with the special debug pool.
type Traceback_Ptr_Or_Address is new System.Address;
-- A type that acts as a C union, and is either a System.Address or a
-- Traceback_Htable_Elem_Ptr.
-- The following record stores extra information that needs to be
-- memorized for each block allocated with the special debug pool.
type Allocation_Header is record
Allocation_Address : System.Address;
-- Address of the block returned by malloc, possibly unaligned.
-- Address of the block returned by malloc, possibly unaligned
Block_Size : Storage_Offset;
Block_Size : Storage_Offset;
-- Needed only for advanced freeing algorithms (traverse all allocated
-- blocks for potential references). This value is negated when the
-- chunk of memory has been logically freed by the application. This
-- chunk has not been physically released yet.
Alloc_Traceback : Traceback_Htable_Elem_Ptr;
Alloc_Traceback : Traceback_Htable_Elem_Ptr;
-- ??? comment required
Dealloc_Traceback : Traceback_Ptr_Or_Address;
-- Pointer to the traceback for the allocation (if the memory chunk is
-- still valid), or to the first deallocation otherwise. Make sure this
@ -177,22 +189,24 @@ package body GNAT.Debug_Pools is
function To_Address is new Ada.Unchecked_Conversion
(Traceback_Ptr_Or_Address, System.Address);
function To_Address is new Ada.Unchecked_Conversion
(System.Address, Traceback_Ptr_Or_Address);
function To_Traceback is new Ada.Unchecked_Conversion
(Traceback_Ptr_Or_Address, Traceback_Htable_Elem_Ptr);
function To_Traceback is new Ada.Unchecked_Conversion
(Traceback_Htable_Elem_Ptr, Traceback_Ptr_Or_Address);
Header_Offset : constant Storage_Count
:= Default_Alignment *
((Allocation_Header'Size / System.Storage_Unit + Default_Alignment - 1)
/ Default_Alignment);
-- Offset of user data after allocation header.
Header_Offset : constant Storage_Count :=
Default_Alignment *
((Allocation_Header'Size / System.Storage_Unit
+ Default_Alignment - 1) / Default_Alignment);
-- Offset of user data after allocation header
Minimum_Allocation : constant Storage_Count :=
Default_Alignment - 1
+ Header_Offset;
Default_Alignment - 1 + Header_Offset;
-- Minimal allocation: size of allocation_header rounded up to next
-- multiple of default alignment + worst-case padding.
@ -200,14 +214,14 @@ package body GNAT.Debug_Pools is
-- Allocations table --
-----------------------
-- This table is indexed on addresses modulo Default_Alignment, and
-- for each index it indicates whether that memory block is valid.
-- Its behavior is similar to GNAT.Table, except that we need to pack
-- the table to save space, so we cannot reuse GNAT.Table as is.
-- This table is indexed on addresses modulo Default_Alignment, and for
-- each index it indicates whether that memory block is valid. Its behavior
-- is similar to GNAT.Table, except that we need to pack the table to save
-- space, so we cannot reuse GNAT.Table as is.
-- This table is the reason why all alignments have to be forced to a
-- common value (Default_Alignment), so that this table can be
-- kept to a reasonnable size.
-- This table is the reason why all alignments have to be forced to common
-- value (Default_Alignment), so that this table can be kept to a
-- reasonnable size.
type Byte is mod 2 ** System.Storage_Unit;
@ -242,18 +256,17 @@ package body GNAT.Debug_Pools is
-- These two variables represents a mapping of the currently allocated
-- memory. Every time the pool works on an address, we first check that the
-- index Address / Default_Alignment is True. If not, this means that this
-- address is not under control of the debug pool, and thus this is
-- probably an invalid memory access (it could also be a general access
-- type).
-- address is not under control of the debug pool and thus this is probably
-- an invalid memory access (it could also be a general access type).
--
-- Note that in fact we never allocate the full size of Big_Table, only a
-- slice big enough to manage the currently allocated memory.
Edata : System.Address := System.Null_Address;
Edata : System.Address := System.Null_Address;
-- Address in memory that matches the index 0 in Valid_Blocks. It is named
-- after the symbol _edata, which, on most systems, indicate the lowest
-- possible address returned by malloc. Unfortunately, this symbol
-- doesn't exist on windows, so we cannot use it instead of this variable.
-- possible address returned by malloc. Unfortunately, this symbol doesn't
-- exist on windows, so we cannot use it instead of this variable.
-----------------------
-- Local subprograms --
@ -264,16 +277,15 @@ package body GNAT.Debug_Pools is
Kind : Traceback_Kind;
Size : Storage_Count;
Ignored_Frame_Start : System.Address;
Ignored_Frame_End : System.Address)
return Traceback_Htable_Elem_Ptr;
Ignored_Frame_End : System.Address) return Traceback_Htable_Elem_Ptr;
-- Return an element matching the current traceback (omitting the frames
-- that are in the current package). If this traceback already existed in
-- the htable, a pointer to this is returned to spare memory. Null is
-- returned if the pool is set not to store tracebacks. If the traceback
-- already existed in the table, the count is incremented so that
-- Dump_Tracebacks returns useful results.
-- All addresses up to, and including, an address between
-- Ignored_Frame_Start .. Ignored_Frame_End are ignored.
-- Dump_Tracebacks returns useful results. All addresses up to, and
-- including, an address between Ignored_Frame_Start .. Ignored_Frame_End
-- are ignored.
procedure Put_Line
(Depth : Natural;
@ -364,9 +376,7 @@ package body GNAT.Debug_Pools is
----------
function Next
(E : Traceback_Htable_Elem_Ptr)
return Traceback_Htable_Elem_Ptr
is
(E : Traceback_Htable_Elem_Ptr) return Traceback_Htable_Elem_Ptr is
begin
return E.Next;
end Next;
@ -386,8 +396,7 @@ package body GNAT.Debug_Pools is
-------------
function Get_Key
(E : Traceback_Htable_Elem_Ptr)
return Tracebacks_Array_Access
(E : Traceback_Htable_Elem_Ptr) return Tracebacks_Array_Access
is
begin
return E.Traceback;
@ -399,10 +408,12 @@ package body GNAT.Debug_Pools is
function Hash (T : Tracebacks_Array_Access) return Header is
Result : Integer_Address := 0;
begin
for X in T'Range loop
Result := Result + To_Integer (PC_For (T (X)));
end loop;
return Header (1 + Result mod Integer_Address (Header'Last));
end Hash;
@ -496,8 +507,7 @@ package body GNAT.Debug_Pools is
Kind : Traceback_Kind;
Size : Storage_Count;
Ignored_Frame_Start : System.Address;
Ignored_Frame_End : System.Address)
return Traceback_Htable_Elem_Ptr
Ignored_Frame_End : System.Address) return Traceback_Htable_Elem_Ptr
is
begin
if Pool.Stack_Trace_Depth = 0 then
@ -515,7 +525,7 @@ package body GNAT.Debug_Pools is
Skip_Levels (Pool.Stack_Trace_Depth, Trace, Start, Len,
Ignored_Frame_Start, Ignored_Frame_End);
-- Check if the traceback is already in the table.
-- Check if the traceback is already in the table
Elem :=
Backtrace_Htable.Get (Trace (Start .. Len)'Unrestricted_Access);
@ -547,9 +557,7 @@ package body GNAT.Debug_Pools is
function Is_Valid (Storage : System.Address) return Boolean is
Offset : constant Storage_Offset :=
(Storage - Edata) / Default_Alignment;
Bit : constant Byte := 2 ** Natural (Offset mod System.Storage_Unit);
begin
return (Storage mod Default_Alignment) = 0
and then Offset >= 0
@ -621,13 +629,27 @@ package body GNAT.Debug_Pools is
Valid_Blocks_Size := Valid_Blocks_Size + Bytes;
-- Take into the account the new start address
Edata := Storage - Edata_Align + (Edata - Storage) mod Edata_Align;
end if;
-- Second case : the new address is outside of the current scope of
-- Valid_Blocks, so we have to grow the table as appropriate
-- Valid_Blocks, so we have to grow the table as appropriate.
Offset := (Storage - Edata) / Default_Alignment;
-- Note: it might seem more natural for the following statement to
-- be written:
-- Offset := (Storage - Edata) / Default_Alignment;
-- but that won't work since Storage_Offset is signed, and it is
-- possible to subtract a small address from a large address and
-- get a negative value. This may seem strange, but it is quite
-- specifically allowed in the RM, and is what most implementations
-- including GNAT actually do. Hence the conversion to Integer_Address
-- which is a full range modular type, not subject to this glitch.
Offset := Storage_Offset ((To_Integer (Storage) - To_Integer (Edata)) /
Default_Alignment);
if Offset >= Valid_Blocks_Size * System.Storage_Unit then
Bytes := Valid_Blocks_Size;
@ -717,10 +739,12 @@ package body GNAT.Debug_Pools is
P := new Local_Storage_Array;
end;
Storage_Address := System.Null_Address + Default_Alignment
* (((P.all'Address + Default_Alignment - 1) - System.Null_Address)
/ Default_Alignment)
Storage_Address :=
System.Null_Address + Default_Alignment
* (((P.all'Address + Default_Alignment - 1) - System.Null_Address)
/ Default_Alignment)
+ Header_Offset;
pragma Assert ((Storage_Address - System.Null_Address)
mod Default_Alignment = 0);
pragma Assert (Storage_Address + Size_In_Storage_Elements
@ -940,7 +964,7 @@ package body GNAT.Debug_Pools is
System.Memory.Free (Header.Allocation_Address);
Set_Valid (Tmp, False);
-- Remove this block from the list.
-- Remove this block from the list
if Previous = System.Null_Address then
Pool.First_Free_Block := Next;
@ -1038,7 +1062,6 @@ package body GNAT.Debug_Pools is
procedure Reset_Marks is
Current : System.Address := Pool.First_Free_Block;
Header : Allocation_Header_Access;
begin
while Current /= System.Null_Address loop
Header := Header_Of (Current);
@ -1126,7 +1149,7 @@ package body GNAT.Debug_Pools is
end if;
else
-- Remove this block from the list of used blocks.
-- Remove this block from the list of used blocks
Previous :=
To_Address (Header_Of (Storage_Address).Dealloc_Traceback);
@ -1459,7 +1482,6 @@ package body GNAT.Debug_Pools is
function Storage_Size (Pool : Debug_Pool) return Storage_Count is
pragma Unreferenced (Pool);
begin
return Storage_Count'Last;
end Storage_Size;
@ -1535,7 +1557,6 @@ package body GNAT.Debug_Pools is
procedure Internal is new Print_Info
(Put_Line => GNAT.IO.Put_Line,
Put => GNAT.IO.Put);
begin
Internal (Pool, Cumulate, Display_Slots, Display_Leaks);
end Print_Info_Stdout;
@ -1594,9 +1615,10 @@ package body GNAT.Debug_Pools is
Tracebk := Header.Alloc_Traceback.Traceback;
Num_Calls := Tracebk'Length;
-- Code taken from memtrack.adb in GNAT's sources
-- Logs allocation call
-- format is:
-- (Code taken from memtrack.adb in GNAT's sources)
-- Logs allocation call using the format:
-- 'A' <mem addr> <size chunk> <len backtrace> <addr1> ... <addrn>
fputc (Character'Pos ('A'), File);