OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

s-stposu.adb (Allocate_Any_Controlled): Reimplement the mechanism which accounts for size vs alignment issues and...

Browse Source 
2011-08-29  Hristian Kirtchev  <kirtchev@adacore.com>

	* s-stposu.adb (Allocate_Any_Controlled): Reimplement the mechanism
	which accounts for size vs alignment issues and calculates the size of
	the list header.
	(Deallocate_Any_Controlled): Ditto.
	(Nearest_Multiple_Rounded_Up): New routine.

From-SVN: r178218
This commit is contained in:
Hristian Kirtchev 2011-08-29 12:56:22 +00:00 committed by Arnaud Charlet
parent 09fae88db5
commit e9c9d12236
2 changed files with 46 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/ada/ChangeLog
View File

@ -1,3 +1,11 @@
2011-08-29 Hristian Kirtchev <kirtchev@adacore.com>
* s-stposu.adb (Allocate_Any_Controlled): Reimplement the mechanism
which accounts for size vs alignment issues and calculates the size of
the list header.
(Deallocate_Any_Controlled): Ditto.
(Nearest_Multiple_Rounded_Up): New routine.
2011-08-29 Tristan Gingold <gingold@adacore.com>
* a-exstat.adb (String_To_EO): Do no set Cleanup_Flag.

48
gcc/ada/s-stposu.adb
View File

@ -46,6 +46,12 @@ package body System.Storage_Pools.Subpools is
procedure Detach (N : not null SP_Node_Ptr);
-- Unhook a subpool node from an arbitrary subpool list
function Nearest_Multiple_Rounded_Up
(Size : Storage_Count;
Alignment : Storage_Count) return Storage_Count;
-- Given arbitrary values of storage size and alignment, calculate the
-- nearest multiple of the alignment rounded up where size can fit.
--------------
-- Allocate --
--------------
@ -191,11 +197,10 @@ package body System.Storage_Pools.Subpools is
-- Account for possible padding space before the header due to a
-- larger alignment.
if Alignment > Header_Size then
Header_And_Padding := Alignment;
else
Header_And_Padding := Header_Size;
end if;
Header_And_Padding :=
Nearest_Multiple_Rounded_Up
(Size => Header_Size,
Alignment => Alignment);
N_Size := Storage_Size + Header_And_Padding;
@ -307,11 +312,14 @@ package body System.Storage_Pools.Subpools is
-- Step 1: Detachment
if Is_Controlled then
if Alignment > Header_Size then
Header_And_Padding := Alignment;
else
Header_And_Padding := Header_Size;
end if;
-- Account for possible padding space before the header due to a
-- larger alignment.
Header_And_Padding :=
Nearest_Multiple_Rounded_Up
(Size => Header_Size,
Alignment => Alignment);
-- N_Addr N_Ptr Addr (from input)
-- | | |
@ -497,6 +505,26 @@ package body System.Storage_Pools.Subpools is
Pool.Subpools.Prev := Pool.Subpools'Unchecked_Access;
end Initialize_Pool;
---------------------------------
-- Nearest_Multiple_Rounded_Up --
---------------------------------
function Nearest_Multiple_Rounded_Up
(Size : Storage_Count;
Alignment : Storage_Count) return Storage_Count
is
begin
if Size mod Alignment = 0 then
return Size;
-- Add enough padding to reach the nearest multiple of the alignment
-- rounding up.
else
return ((Size + Alignment - 1) / Alignment) * Alignment;
end if;
end Nearest_Multiple_Rounded_Up;
---------------------
-- Pool_Of_Subpool --
---------------------