Patchwork [Ada] Handle alignment for controlled objects

login
register
mail settings
Submitter Arnaud Charlet
Date Aug. 29, 2011, 9:39 a.m.
Message ID <20110829093904.GA26415@adacore.com>
Download mbox | patch
Permalink /patch/112001/
State New
Headers show

Comments

Arnaud Charlet - Aug. 29, 2011, 9:39 a.m.
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  <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.

Patch

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;