stack2: use a minimal size for chunks.

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,