Re: Using local storage pools...

[Ludovic Brenta <ludovic@ludovic-brenta.org>]

Brian Drummond writes:
> I am trying to learn a little about storage pools, with a view to
> (hopefully) using local pools to improve the Binary_Trees benchmark in
> the same way as some of the faster C benchmarks.
>
> Arguably they cheat : they do not explicitly free each tree node (the
> "free" call has been deleted!) but free the entire pool at the end of
> the loop.  But if that's valid, Ada should be able to do the same.
>
> http://gcc.gnu.org/onlinedocs/gcc-4.1.2/gnat_ugn_unw/Some-Useful-Memory-Pools.html
> suggests System.Pool_Local offers a way to do likewise - a pool that
> is automatically reclaimed when it goes out of scope.
>
> This turns out to have its own performance problem, but that is
> another story...
>
> The question(or four) for now is ... should the following really raise
> Storage_Error, i.e. am I doing something silly, and if so, what?  Or
> is this a bug in Gnat?
>
> NOTE - using System.Pool_Global.Unbounded_No_Reclaim_Pool (commented
> out) instead of the pool shown, works as expected.
>
> (Tested on GCC4.5.0 and Libre 2010)
>
> - Brian
>
> ------------------------------------------------------------------------------------
> with System.Pool_Local;
> with System.Pool_Global;
> with Ada.Unchecked_Deallocation;
>
> procedure pooltest is
>
>    type Node;
>    type Treenode is access Node;
>    type Node is record
>       Left  : Treenode := null;
>       Right : Treenode := null;
>       Item  : Integer  := 0; 
>    end record;
>
>    P : System.Pool_Local.Unbounded_Reclaim_Pool;    
>    --P : System.Pool_Global.Unbounded_No_Reclaim_Pool;
>    for Treenode'Storage_Pool use P;
>
>    procedure free is new Ada.Unchecked_Deallocation(Node, Treenode);
>
>    TestNode : Treenode;
>
> begin
>    Testnode := new Node'(null, null, 1);
>    free(Testnode);   
> end pooltest;
> ------------------------------------------------------------------------------------

This looks like a genuine bug at s-pooloc.adb:114.  To trigger the bug,
two conditions must hold simultaneously:

* the pool contains exactly one allocated object.
* the user calls Unchecked_Deallocation on this object.

The buggy code is:

   procedure Deallocate
     (Pool         : in out Unbounded_Reclaim_Pool;
      Address      : System.Address;
      Storage_Size : SSE.Storage_Count;
      Alignment    : SSE.Storage_Count)
   is
      pragma Warnings (Off, Storage_Size);
      pragma Warnings (Off, Alignment);

      Allocated : constant System.Address := Address - Pointers_Size;

   begin
      if Prev (Allocated).all = Null_Address then
         Pool.First := Next (Allocated).all;
         Prev (Pool.First).all := Null_Address; ------- <- Storage_Error
      else
         Next (Prev (Allocated).all).all := Next (Allocated).all;
      end if;

      if Next (Allocated).all /= Null_Address then
         Prev (Next (Allocated).all).all := Prev (Allocated).all;
      end if;

      Memory.Free (Allocated);
   end Deallocate;

This procedure is *not* called by the finalization of the pool, which
simply walks the linked list of nodes and deallocates each one, but does
not modify any nodes.

Because this pool is intended for use without any explicit
Unchecked_Deallocation, I would qualify this bug as minor.

The workaround, in your case, is to simply not do any
Unchecked_Deallocation and let the finalization of the storage pool do
the deallocation.

-- 
Ludovic Brenta.