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 --------------