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

[multiple changes]

Browse Source 
2011-08-29  Robert Dewar  <dewar@adacore.com>

	* frontend.adb, gnat1drv.adb: Minor reformatting.

2011-08-29  Tristan Gingold  <gingold@adacore.com>

	* s-pooglo.adb (Allocate, Deallocate): Take into account the alignment.
	* a-fihema.adb (Allocate, Deallocate): Ditto.  Possibly add padding
	space in front of the header.

From-SVN: r178181
This commit is contained in:
Arnaud Charlet 2011-08-29 11:38:56 +02:00
parent 4bcd641141
commit 1a07a71a4b
6 changed files with 102 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/ada/ChangeLog
View File

@ -1,3 +1,13 @@
2011-08-29 Robert Dewar <dewar@adacore.com>
* frontend.adb, gnat1drv.adb: Minor reformatting.
2011-08-29 Tristan Gingold <gingold@adacore.com>
* s-pooglo.adb (Allocate, Deallocate): Take into account the alignment.
* a-fihema.adb (Allocate, Deallocate): Ditto. Possibly add padding
space in front of the header.
2011-08-29 Johannes Kanig <kanig@adacore.com>
* frontend.adb (Frontend): Exit after creating Standard package when

51
gcc/ada/a-fihema.adb
View File

@ -51,10 +51,6 @@ package body Ada.Finalization.Heap_Management is
-- Allocate/Deallocate to determine the Storage_Size passed to the
-- underlying pool.
Header_Offset : constant Storage_Offset := Header_Size;
-- Offset from the header to the actual object. Used to get from the
-- address of a header to the address of the actual object, and vice-versa.
function Address_To_Node_Ptr is
new Ada.Unchecked_Conversion (Address, Node_Ptr);
@ -136,10 +132,21 @@ package body Ada.Finalization.Heap_Management is
end if;
declare
N_Addr : Address;
N_Ptr : Node_Ptr;
Header_Offset : Storage_Offset;
N_Addr : Address;
N_Ptr : Node_Ptr;
begin
-- Offset from the header to the actual object. The header is
-- just in front of the object. There may be padding space before
-- the header.
if Alignment > Header_Size then
Header_Offset := Alignment;
else
Header_Offset := Header_Size;
end if;
-- Use the underlying pool to allocate enough space for the object
-- and the list header. The returned address points to the list
-- header. If locking is necessary, it will be done by the
@ -148,13 +155,14 @@ package body Ada.Finalization.Heap_Management is
Allocate
(Collection.Base_Pool.all,
N_Addr,
Storage_Size + Header_Size,
Storage_Size + Header_Offset,
Alignment);
-- Map the allocated memory into a Node record. This converts the
-- top of the allocated bits into a list header.
N_Ptr := Address_To_Node_Ptr (N_Addr);
N_Ptr := Address_To_Node_Ptr
(N_Addr + Header_Offset - Header_Size);
Attach (N_Ptr, Collection.Objects'Unchecked_Access);
-- Move the address from Prev to the start of the object. This
@ -224,19 +232,28 @@ package body Ada.Finalization.Heap_Management is
if Has_Header then
declare
N_Addr : Address;
N_Ptr : Node_Ptr;
Header_Offset : Storage_Offset;
N_Addr : Address;
N_Ptr : Node_Ptr;
begin
-- Move address from the object to beginning of the list header
-- Offset from the header to the actual object.
if Alignment > Header_Size then
Header_Offset := Alignment;
else
Header_Offset := Header_Size;
end if;
-- Converts from the object to the list header
N_Ptr := Address_To_Node_Ptr (Addr - Header_Size);
Detach (N_Ptr);
-- Converts the bits preceding the object the block address.
N_Addr := Addr - Header_Offset;
-- Converts the bits preceding the object into a list header
N_Ptr := Address_To_Node_Ptr (N_Addr);
Detach (N_Ptr);
-- Use the underlying pool to destroy the object along with the
-- list header.
@ -340,7 +357,7 @@ package body Ada.Finalization.Heap_Management is
if Collection.Finalize_Address /= null then
declare
Object_Address : constant Address :=
Node.all'Address + Header_Offset;
Node.all'Address + Header_Size;
-- Get address of object from address of header
begin

3
gcc/ada/a-fihema.ads
View File

@ -119,7 +119,8 @@ private
-- full view of Limited_Controlled, which is NOT limited. Note that default
-- initialization does not happen for this type (the pointers will not be
-- automatically set to null), because of the games we're playing with
-- address arithmetic.
-- address arithmetic. Code in the body assumes that the size of
-- this record is a power of 2 to deal with alignment.
type Node is record
Prev : Node_Ptr;

1
gcc/ada/frontend.adb
View File

@ -100,6 +100,7 @@ begin
-- If the -gnatd.H flag is present, we are only interested in the Standard
-- package, so the frontend has done its job here.
if Debug_Flag_Dot_HH then
return;
end if;

18
gcc/ada/gnat1drv.adb
View File

@ -770,12 +770,18 @@ begin
Original_Operating_Mode := Operating_Mode;
Frontend;
-- Exit with errors if the main source could not be parsed
-- Also, when -gnatd.H is present, the source file is not set.
-- Exit with errors if the main source could not be parsed. Also, when
-- -gnatd.H is present, the source file is not set.
if Sinput.Main_Source_File = No_Source_File then
-- Handle -gnatd.H debug mode
if Debug_Flag_Dot_HH then
-- We lock all the tables to keep the convention that the backend
-- needs to unlock the tables it wants to touch.
-- For -gnatd.H, lock all the tables to keep the convention that
-- the backend needs to unlock the tables it wants to touch.
Atree.Lock;
Elists.Lock;
Fname.UF.Lock;
@ -786,8 +792,12 @@ begin
Sinput.Lock;
Namet.Lock;
Stringt.Lock;
-- And all we need to do is to call the back end
Back_End.Call_Back_End (Back_End.Generate_Object);
end if;
Errout.Finalize (Last_Call => True);
Errout.Output_Messages;
Exit_Program (E_Errors);

46
gcc/ada/s-pooglo.adb
View File

@ -46,13 +46,19 @@ package body System.Pool_Global is
Storage_Size : SSE.Storage_Count;
Alignment : SSE.Storage_Count)
is
use SSE;
pragma Warnings (Off, Pool);
pragma Warnings (Off, Alignment);
Allocated : System.Address;
Aligned_Size : Storage_Count := Storage_Size;
Aligned_Address : System.Address;
Allocated : System.Address;
begin
Allocated := Memory.Alloc (Memory.size_t (Storage_Size));
if Alignment > Standard'System_Allocator_Alignment then
Aligned_Size := Aligned_Size + Alignment;
end if;
Allocated := Memory.Alloc (Memory.size_t (Aligned_Size));
-- The call to Alloc returns an address whose alignment is compatible
-- with the worst case alignment requirement for the machine; thus the
@ -60,6 +66,24 @@ package body System.Pool_Global is
if Allocated = Null_Address then
raise Storage_Error;
end if;
if Alignment > Standard'System_Allocator_Alignment then
-- Realign the returned address.
Aligned_Address := To_Address
(To_Integer (Allocated) + Integer_Address (Alignment)
- (To_Integer (Allocated) mod Integer_Address (Alignment)));
-- Save the block address.
declare
Saved_Address : System.Address;
pragma Import (Ada, Saved_Address);
for Saved_Address'Address use
Aligned_Address
- Storage_Offset (System.Address'Size / Storage_Unit);
begin
Saved_Address := Allocated;
end;
Address := Aligned_Address;
else
Address := Allocated;
end if;
@ -75,12 +99,24 @@ package body System.Pool_Global is
Storage_Size : SSE.Storage_Count;
Alignment : SSE.Storage_Count)
is
use System.Storage_Elements;
pragma Warnings (Off, Pool);
pragma Warnings (Off, Storage_Size);
pragma Warnings (Off, Alignment);
begin
Memory.Free (Address);
if Alignment > Standard'System_Allocator_Alignment then
-- Retrieve the block address.
declare
Saved_Address : System.Address;
pragma Import (Ada, Saved_Address);
for Saved_Address'Address use
Address - Storage_Offset (System.Address'Size / Storage_Unit);
begin
Memory.Free (Saved_Address);
end;
else
Memory.Free (Address);
end if;
end Deallocate;
------------------