The new implementation of controlled objects didn't handle
all alignments cases.
No behaviour change compared to the previous implementation.
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-08-29 Tristan Gingold <ging...@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.
Index: s-pooglo.adb
===================================================================
--- s-pooglo.adb (revision 178155)
+++ s-pooglo.adb (working copy)
@@ -46,20 +46,44 @@
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
-- Alignment argument can be safely ignored.
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 @@
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;
------------------
Index: a-fihema.adb
===================================================================
--- a-fihema.adb (revision 178155)
+++ a-fihema.adb (working copy)
@@ -51,10 +51,6 @@
-- 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 @@
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 @@
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 @@
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 @@
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
Index: a-fihema.ads
===================================================================
--- a-fihema.ads (revision 178155)
+++ a-fihema.ads (working copy)
@@ -119,7 +119,8 @@
-- 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;
