diff options
| -rw-r--r-- | src/grt/grt-stack2.adb | 56 |
1 files changed, 33 insertions, 23 deletions
diff --git a/src/grt/grt-stack2.adb b/src/grt/grt-stack2.adb index 00698d51c..1ae18be5a 100644 --- a/src/grt/grt-stack2.adb +++ b/src/grt/grt-stack2.adb @@ -33,6 +33,9 @@ package body Grt.Stack2 is -- currently a failure (storage_elements is automagically used). type Memory is array (Mark_Id range <>) of Character; + -- Minimal chunk size. Avoid to allocate too many small chunks. + Min_Chunk_Size : constant Mark_Id := 8 * 1024; + type Chunk_Type (First, Last : Mark_Id); type Chunk_Acc is access all Chunk_Type; type Chunk_Type (First, Last : Mark_Id) is record @@ -43,6 +46,8 @@ package body Grt.Stack2 is type Stack2_Type is record First_Chunk : Chunk_Acc; Last_Chunk : Chunk_Acc; + + -- Index of the first free byte. Top : Mark_Id; end record; type Stack2_Acc is access all Stack2_Type; @@ -77,14 +82,16 @@ package body Grt.Stack2 is S2 : constant Stack2_Acc := To_Acc (S); Chunk : Chunk_Acc; N_Chunk : Chunk_Acc; + L_Chunk : Chunk_Acc; Max_Align : constant Mark_Id := Mark_Id (Standard'Maximum_Alignment); - Max_Size : constant Mark_Id := + Aligned_Size : constant Mark_Id := ((Mark_Id (Size) + Max_Align - 1) / Max_Align) * Max_Align; Res : System.Address; begin -- Find the chunk to which S2.TOP belong. + -- FIXME: save an hint to that value ? Chunk := S2.First_Chunk; loop exit when S2.Top >= Chunk.First and S2.Top <= Chunk.Last; @@ -94,37 +101,40 @@ package body Grt.Stack2 is if Chunk /= null then -- If there is enough place in it, allocate from the chunk. - if Max_Size <= Chunk.Last - S2.Top + 1 then + if Aligned_Size <= Chunk.Last - S2.Top + 1 then Res := Chunk.Mem (S2.Top)'Address; - S2.Top := S2.Top + Max_Size; + S2.Top := S2.Top + Aligned_Size; return Res; end if; - -- If there is not enough place in it: - -- find a chunk which has enough room, deallocate skipped chunk. - loop - N_Chunk := Chunk.Next; - exit when N_Chunk = null; - if N_Chunk.Last - N_Chunk.First + 1 < Max_Size then - -- Not enough place in this chunk. - Chunk.Next := N_Chunk.Next; - Free (N_Chunk); - if Chunk.Next = null then - S2.Last_Chunk := Chunk; - exit; - end if; - else - Res := N_Chunk.Mem (N_Chunk.First)'Address; - S2.Top := N_Chunk.First + Max_Size; + -- If there is not enough place in it: try the next one. If not + -- enough room, free it and all the following chunks. + L_Chunk := Chunk; + Chunk := Chunk.Next; + if Chunk /= null then + if Aligned_Size <= Chunk.Last - Chunk.First + 1 then + Res := Chunk.Mem (Chunk.First)'Address; + S2.Top := Chunk.First + Aligned_Size; return Res; + else + -- Free Chunk and all the following ones. Do not forget to + -- update Last_Chunk. + S2.Last_Chunk := L_Chunk; + loop + N_Chunk := Chunk.Next; + Free (Chunk); + Chunk := N_Chunk; + exit when Chunk = null; + end loop; end if; - end loop; + end if; end if; -- If not such chunk, allocate a chunk S2.Top := S2.Last_Chunk.Last + 1; - Chunk := new Chunk_Type (First => S2.Top, - Last => S2.Top + Max_Size - 1); + Chunk := new Chunk_Type + (First => S2.Top, + Last => S2.Top + Mark_Id'Max (Aligned_Size, Min_Chunk_Size) - 1); Chunk.Next := null; S2.Last_Chunk.Next := Chunk; S2.Last_Chunk := Chunk; @@ -136,7 +146,7 @@ package body Grt.Stack2 is Res : Stack2_Acc; Chunk : Chunk_Acc; begin - Chunk := new Chunk_Type (First => 1, Last => 8 * 1024); + Chunk := new Chunk_Type (First => 1, Last => Min_Chunk_Size); Chunk.Next := null; Res := new Stack2_Type'(First_Chunk => Chunk, Last_Chunk => Chunk, |