From afc487704905873bb6cadaf0a652327160a1d1a0 Mon Sep 17 00:00:00 2001 From: charlet Date: Mon, 29 Aug 2011 09:38:56 +0000 Subject: [PATCH] 2011-08-29 Robert Dewar * frontend.adb, gnat1drv.adb: Minor reformatting. 2011-08-29 Tristan Gingold * 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@178181 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 10 ++++++++++ gcc/ada/a-fihema.adb | 47 ++++++++++++++++++++++++++++++++--------------- gcc/ada/a-fihema.ads | 3 ++- gcc/ada/frontend.adb | 1 + gcc/ada/gnat1drv.adb | 18 ++++++++++++++---- gcc/ada/s-pooglo.adb | 46 +++++++++++++++++++++++++++++++++++++++++----- 6 files changed, 100 insertions(+), 25 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f48eafe..b63a9f3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2011-08-29 Robert Dewar + + * frontend.adb, gnat1drv.adb: Minor reformatting. + +2011-08-29 Tristan Gingold + + * 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 * frontend.adb (Frontend): Exit after creating Standard package when diff --git a/gcc/ada/a-fihema.adb b/gcc/ada/a-fihema.adb index 3759e71..2eadd0c 100644 --- a/gcc/ada/a-fihema.adb +++ b/gcc/ada/a-fihema.adb @@ -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. - N_Addr := Addr - Header_Offset; + if Alignment > Header_Size then + Header_Offset := Alignment; + else + Header_Offset := Header_Size; + end if; - -- Converts the bits preceding the object into a list header + -- Converts from the object to the list header - N_Ptr := Address_To_Node_Ptr (N_Addr); + 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; + -- 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 diff --git a/gcc/ada/a-fihema.ads b/gcc/ada/a-fihema.ads index e3f412f..6e829d2 100644 --- a/gcc/ada/a-fihema.ads +++ b/gcc/ada/a-fihema.ads @@ -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; diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb index f849d31..2dad57a 100644 --- a/gcc/ada/frontend.adb +++ b/gcc/ada/frontend.adb @@ -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; diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index b494bd4..7ae04fe 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -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); diff --git a/gcc/ada/s-pooglo.adb b/gcc/ada/s-pooglo.adb index dc55962..de96aa0 100644 --- a/gcc/ada/s-pooglo.adb +++ b/gcc/ada/s-pooglo.adb @@ -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; ------------------ -- 2.7.4