+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
-- 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);
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
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
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.
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
-- 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;
-- 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;
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;
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);
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
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;
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;
------------------
projects / gcc.git / commitdiff