[Ada] Handle secondary stack memory allocations alignment

[Ada] Handle secondary stack memory allocations alignment

[Pierre-Marie de Rodat]

[-- Attachment #1: Type: text/plain, Size: 1196 bytes --]

To accomodate cases where objects allocated on the secondary stack
needed a more constrained alignement than Standard'Maximum_Alignement,
the alignment for all allocations in the full runtime were forced on to
be aligned on Standard'Maximum_Alignement*2. This changes removes this
workaround and correctly handles the over-alignment in all runtimes.

This change modifies the SS_Allocate procedure to accept a new Alignment
parameter and to dynamically realign the pointer returned by the memory
allocation (Allocate_* functions or dedicated stack allocations for
zfp/cert).

It also simplifies the 0-sized allocations by not allocating any memory
if pointer is already correctly aligned (already the case in cert and
zfp runtimes).

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* libgnat/s-secsta.ads (SS_Allocate): Add new Alignment
	parameter.
	(Memory_Alignment): Remove.
	* libgnat/s-secsta.adb (Align_Addr): New.
	(SS_Allocate): Add new Alignment parameter. Realign pointer if
	needed. Don't allocate anything for 0-sized allocations.
	* gcc-interface/utils2.cc (build_call_alloc_dealloc_proc): Add
	allocated object's alignment as last parameter to allocation
	invocation.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 8809 bytes --]

diff --git a/gcc/ada/gcc-interface/utils2.cc b/gcc/ada/gcc-interface/utils2.cc
--- a/gcc/ada/gcc-interface/utils2.cc
+++ b/gcc/ada/gcc-interface/utils2.cc
@@ -2139,6 +2139,8 @@ build_call_alloc_dealloc_proc (tree gnu_obj, tree gnu_size, tree gnu_type,
 			       Entity_Id gnat_proc, Entity_Id gnat_pool)
 {
   tree gnu_proc = gnat_to_gnu (gnat_proc);
+  tree gnu_align = size_int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT);
+
   tree gnu_call;
 
   /* A storage pool's underlying type is a record type for both predefined
@@ -2154,7 +2156,6 @@ build_call_alloc_dealloc_proc (tree gnu_obj, tree gnu_size, tree gnu_type,
 
       tree gnu_pool = gnat_to_gnu (gnat_pool);
       tree gnu_pool_addr = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_pool);
-      tree gnu_align = size_int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT);
 
       gnu_size = convert (gnu_size_type, gnu_size);
       gnu_align = convert (gnu_size_type, gnu_align);
@@ -2178,6 +2179,7 @@ build_call_alloc_dealloc_proc (tree gnu_obj, tree gnu_size, tree gnu_type,
       tree gnu_size_type = gnat_to_gnu_type (gnat_size_type);
 
       gnu_size = convert (gnu_size_type, gnu_size);
+      gnu_align = convert (gnu_size_type, gnu_align);
 
       if (DECL_BUILT_IN_CLASS (gnu_proc) == BUILT_IN_FRONTEND
 	  && DECL_FE_FUNCTION_CODE (gnu_proc) == BUILT_IN_RETURN_SLOT)
@@ -2191,7 +2193,7 @@ build_call_alloc_dealloc_proc (tree gnu_obj, tree gnu_size, tree gnu_type,
 
 	  gnu_call = DECL_RESULT (current_function_decl);
 
-	  /* The allocation has alreay been done by the caller so we check that
+	  /* The allocation has already been done by the caller so we check that
 	     we are not going to overflow the return slot.  */
 	  if (TYPE_CI_CO_LIST (TREE_TYPE (current_function_decl)))
 	    gnu_ret_size
@@ -2216,7 +2218,7 @@ build_call_alloc_dealloc_proc (tree gnu_obj, tree gnu_size, tree gnu_type,
 	gnu_call = build_call_n_expr (gnu_proc, 2, gnu_obj, gnu_size);
 
       else
-	gnu_call = build_call_n_expr (gnu_proc, 1, gnu_size);
+	gnu_call = build_call_n_expr (gnu_proc, 2, gnu_size, gnu_align);
     }
 
   return gnu_call;
@@ -2334,7 +2336,7 @@ maybe_wrap_free (tree data_ptr, tree data_type)
 
 /* Build a GCC tree to call an allocation or deallocation function.
    If GNU_OBJ is nonzero, it is an object to deallocate.  Otherwise,
-   generate an allocator.
+   generate an allocation.
 
    GNU_SIZE is the number of bytes to allocate and GNU_TYPE is the contained
    object type, used to determine the to-be-honored address alignment.


diff --git a/gcc/ada/libgnat/s-secsta.adb b/gcc/ada/libgnat/s-secsta.adb
--- a/gcc/ada/libgnat/s-secsta.adb
+++ b/gcc/ada/libgnat/s-secsta.adb
@@ -550,22 +550,52 @@ package body System.Secondary_Stack is
 
    procedure SS_Allocate
      (Addr         : out Address;
-      Storage_Size : Storage_Count)
+      Storage_Size : Storage_Count;
+      Alignment    : SSE.Storage_Count := Standard'Maximum_Alignment)
    is
+
       function Round_Up (Size : Storage_Count) return Memory_Size;
       pragma Inline (Round_Up);
       --  Round Size up to the nearest multiple of the maximum alignment
 
+      function Align_Addr (Addr : Address) return Address;
+      pragma Inline (Align_Addr);
+      --  Align Addr to the next multiple of Alignment
+
+      ----------------
+      -- Align_Addr --
+      ----------------
+
+      function Align_Addr (Addr : Address) return Address is
+         Int_Algn : constant Integer_Address := Integer_Address (Alignment);
+         Int_Addr : constant Integer_Address := To_Integer (Addr);
+      begin
+
+         --  L : Alignment
+         --  A : Standard'Maximum_Alignment
+
+         --           Addr
+         --      L     |     L           L
+         --      A--A--A--A--A--A--A--A--A--A--A
+         --                  |     |
+         --      \----/      |     |
+         --     Addr mod L   |   Addr + L
+         --                  |
+         --                Addr + L - (Addr mod L)
+
+         return To_Address (Int_Addr + Int_Algn - (Int_Addr mod Int_Algn));
+      end Align_Addr;
+
       --------------
       -- Round_Up --
       --------------
 
       function Round_Up (Size : Storage_Count) return Memory_Size is
-         Algn_MS : constant Memory_Size := Memory_Alignment;
+         Algn_MS : constant Memory_Size := Standard'Maximum_Alignment;
          Size_MS : constant Memory_Size := Memory_Size (Size);
 
       begin
-         --  Detect a case where the Storage_Size is very large and may yield
+         --  Detect a case where the Size is very large and may yield
          --  a rounded result which is outside the range of Chunk_Memory_Size.
          --  Treat this case as secondary-stack depletion.
 
@@ -581,27 +611,46 @@ package body System.Secondary_Stack is
       Stack    : constant SS_Stack_Ptr := Get_Sec_Stack.all;
       Mem_Size : Memory_Size;
 
+      Over_Aligning : constant Boolean :=
+        Alignment > Standard'Maximum_Alignment;
+
+      Padding : SSE.Storage_Count := 0;
+
    --  Start of processing for SS_Allocate
 
    begin
-      --  Round the requested size up to the nearest multiple of the maximum
-      --  alignment to ensure efficient access.
+      --  Alignment must be a power of two and can be:
 
-      if Storage_Size = 0 then
-         Mem_Size := Memory_Alignment;
-      else
-         --  It should not be possible to request an allocation of negative
-         --  size.
+      --  - lower than or equal to Maximum_Alignment, in which case the result
+      --    will be aligned on Maximum_Alignment;
+      --  - higher than Maximum_Alignment, in which case the result will be
+      --    dynamically realigned.
 
-         pragma Assert (Storage_Size >= 0);
-         Mem_Size := Round_Up (Storage_Size);
+      if Over_Aligning then
+         Padding := Alignment;
       end if;
 
+      --  Round the requested size (plus the needed padding in case of
+      --  over-alignment) up to the nearest multiple of the default
+      --  alignment to ensure efficient access and that the next available
+      --  Byte is always aligned on the default alignement value.
+
+      --  It should not be possible to request an allocation of negative
+      --  size.
+
+      pragma Assert (Storage_Size >= 0);
+      Mem_Size := Round_Up (Storage_Size + Padding);
+
       if Sec_Stack_Dynamic then
          Allocate_Dynamic (Stack, Mem_Size, Addr);
       else
          Allocate_Static  (Stack, Mem_Size, Addr);
       end if;
+
+      if Over_Aligning then
+         Addr := Align_Addr (Addr);
+      end if;
+
    end SS_Allocate;
 
    -------------


diff --git a/gcc/ada/libgnat/s-secsta.ads b/gcc/ada/libgnat/s-secsta.ads
--- a/gcc/ada/libgnat/s-secsta.ads
+++ b/gcc/ada/libgnat/s-secsta.ads
@@ -69,11 +69,13 @@ package System.Secondary_Stack is
 
    procedure SS_Allocate
      (Addr         : out Address;
-      Storage_Size : SSE.Storage_Count);
+      Storage_Size : SSE.Storage_Count;
+      Alignment    : SSE.Storage_Count := Standard'Maximum_Alignment);
    --  Allocate enough space on the secondary stack of the invoking task to
-   --  accommodate an alloction of size Storage_Size. Return the address of the
-   --  first byte of the allocation in Addr. The routine may carry out one or
-   --  more of the following actions:
+   --  accommodate an allocation of size Storage_Size. Return the address of
+   --  the first byte of the allocation in Addr, which is a multiple of
+   --  Alignment. The routine may carry out one or more of the following
+   --  actions:
    --
    --    * Reuse an existing chunk that is big enough to accommodate the
    --      requested Storage_Size.
@@ -259,22 +261,8 @@ private
    subtype Memory_Index is Memory_Size;
    --  Index into the memory storage of a single chunk
 
-   Memory_Alignment : constant := Standard'Maximum_Alignment * 2;
-   --  The memory alignment we will want to honor on every allocation.
-   --
-   --  At this stage, gigi assumes we can accommodate any alignment requirement
-   --  there might be on the data type for which the memory gets allocated (see
-   --  build_call_alloc_dealloc).
-   --
-   --  The multiplication factor is intended to account for requirements
-   --  by user code compiled with specific arch/cpu options such as -mavx
-   --  on X86[_64] targets, which Standard'Maximum_Alignment doesn't convey
-   --  without such compilation options. * 4 would actually be needed to
-   --  support -mavx512f on X86, but this would incur more annoying memory
-   --  consumption overheads.
-
    type Chunk_Memory is array (Memory_Size range <>) of SSE.Storage_Element;
-   for Chunk_Memory'Alignment use Memory_Alignment;
+   for Chunk_Memory'Alignment use Standard'Maximum_Alignment;
    --  The memory storage of a single chunk
 
    --------------