AdaPower Logged in as Guest
Ada Tools and Resources

Ada 95 Reference Manual
Ada Source Code Treasury
Bindings and Packages
Ada FAQ


Join >
Home >
Articles >
Getting Started >
Ada FAQ >
Source Treasury >
Books & Tutorials >
Packages for Reuse >
Latest Additions >
Ada Projects >
Press Releases >
Ada Audio / Video >
Home Pages >
Links >
Contact >
About >
Login >
Back
Library Design: Strategies, Adapters, and Concurrency (Matthew Heaney)


Let's design a library of reusable data structure components that we can
mix and match into any combination.

The first thing to decide is what the dimensions of the library are:

o A "bounded" component as allocated statically.  It is implemented
using an array, and the client specifies what the maximum number of
items is.

o An "unbounded" component allocates nodes from a storage pool.  It
grows and shrinks in size as the number of items changes.

o A "static" storage pool is like a heap with a fixed size, and the
client specifies what the maximum size is.

o An "dynamic" storage pool allocates new nodes off the heap, and caches
unused nodes.

o A "sequential" component can only be accessed only by a single thread.

o A "concurrent" component can safely be accessed by multiple threads.

o A "controlled" component is sequential, but with a concurrent storage
pool.


These dimensions were largely inspired by the Ada83 Booch Components.
Now let's figure out what the size of the design space is:

o A bounded component can be sequential or concurrent.  It doesn't use a
storage pool.  That's two possibilities.

o An unbounded component uses a static or a dynamic storage pool.  For
the concurrency behavior:

1) both the component and the pool can be sequential; or,
2) just the pool can be concurrent ("controlled"); or,
3) both the component and the pool are concurrent.

That's six possibilities.

A brute-force implementation of this library would provide separate
implementations for each kind of data structure.  So for example there
would be eight versions of a stack.

The problem is that if you add another memory management strategy (say),
then you have to go back and add the new implementation for every data
structure.  Or you might decide you want to have guarded data structures
too.  You end up with a "combinatorial explosion" of possibilities that
makes the library large and unwieldy.

It would be better if we could simply parameterize a component with a
memory management strategy, or adapt a sequential component to allow
concurrent access.  The client can just plug in the specific behavior he
requires, and we can keep the library small.

In general, when building reusable component library, it's best to
provide simple primitives that can be used to construct more complex
abstractions.


Implementation of the Sequential Forms

We're going to build a small library that can be used to construct stack
abstractions.  The library must provide separate implementations for
bounded stack and an unbounded stack, because they have fundamentally
different representations.

We've seen the bounded stack already in previous articles:

  generic

     type Item_Type is private;

     Max_Depth : in Positive;

  package ACL.Stacks_Bounded is

     type Stack_Type is tagged limited private;

     procedure Push
       (Item : in     Item_Type;
        On   : in out Stack_Type);

     procedure Pop
       (Stack : in out Stack_Type);

     ...

  private

     ...

     type Stack_Type is
        tagged limited record
           Items : Item_Array;
           Top   : Natural := 0;
        end record;

  end ACL.Stacks_Bounded;


A bounded sequential stack has a very simple instantiation:

  with ACL.Stacks_Bounded;

  package Integer_Stacks_Bounded is
    new ACL.Stacks_Bounded (Integer, Max_Depth => 10);


The unbounded form is more interesting, because we're going to
parameterize the stack with a strategy for storage management.  Here's
the basic template first:

  generic

     type Item_Type is private;

     ...

  package ACL.Stacks_Unbounded is

     type Stack_Type is tagged limited private;


     procedure Push
       (Item : in     Item_Type;
        On   : in out Stack_Type);

     procedure Pop
       (Stack : in out Stack_Type);

     ...

  private

     ...

     type Stack_Type is
        tagged limited record
           Top     : Storage_Node_Access;
           Control : Stack_Control (Stack_Type'Access);
        end record;

  end ACL.Stacks_Unbounded;


The unbounded form implements the stack as a linked list of storage
nodes (containing an item and a next pointer), together with a control
component to reclaim storage when the stack object is finalized.

In order to implement Push, we need to allocate a new storage node from
a storage pool:

   procedure Push
     (Item : in     Item_Type;
      On   : in out Stack_Type) is

      Node : Storage_Node_Access;
   begin
      Allocate (Storage, Node);   <--

      Node.Item := Item;
      Node.Next := On.Top;

      On.Top := Node;
   end Push;


To implement Pop, we need to deallocate the top node:

   procedure Pop
     (Stack : in out Stack_Type) is

      Node : Storage_Node_Access := Stack.Top;
   begin
      Stack.Top := Stack.Top.Next;
      Deallocate (Storage, Node);   <--
   end Pop;


We want to keep the representation of the storage pool separate from the
unbounded stacks.  Some clients (say, in the high-integrity domain)
can't use heap, and would use a fixed-size static pool.  Other clients
will choose to allocate nodes off the heap, from a dynamic pool.

In order to allow the client to choose the strategy for storage pool
management (we shouldn't choose for him), the unbounded stack package
imports the storage pool as a generic formal object:

  generic

     type Item_Type is private;

     ...

     Storage : in out Item_Storage_Type;   <--

  package ACL.Stacks_Unbounded is


There's another way to do it, but in this implementation
Item_Storage_Type is a type in a storage pool class with operations to
Allocate and Deallocate storage nodes:

  generic
     ...
  package ACL.Storage is

     type Root_Storage_Type is abstract tagged limited null record;

     procedure Allocate
       (Storage : in out Root_Storage_Type;
        Node    :    out Storage_Node_Access) is abstract;

     procedure Deallocate
       (Storage : in out Root_Storage_Type;
        Node    : in out Storage_Node_Access) is abstract;

  end ACL.Storage;


The unbounded stack component accepts an instantiation of the storage
package as a generic formal package (since that's what defines the
class), and imports the specific storage pool type:

  generic

     type Item_Type is private;

     ...

     with package Item_Storage is                         <--
       new Storage ...;

     type Item_Storage_Type (<>) is
       new Item_Storage.Root_Storage_Type with private;   <--

     Storage : in out Item_Storage_Type;

  package ACL.Stacks_Unbounded is


Because both the storage pool and the unbounded stack (and indeed, any
other kind of data structure) need to understand the representation of a
storage node, we declare it as a separate component:

  generic

     type Item_Type is limited private;

  package ACL.Storage_Nodes is

     type Storage_Node;
     type Storage_Node_Access is access all Storage_Node;

     type Storage_Node is
        limited record
           Item : aliased Item_Type;
           Next : Storage_Node_Access;
           Prev : Storage_Node_Access;
        end record;

  end ACL.Storage_Nodes;


An instantiation of node package is imported by the unbounded stacks
package and the storage type package:

  generic

     type Item_Type is private;

     with package Item_Nodes is         <--
      new Storage_Nodes (Item_Type);

     with package Item_Storage is
       new Storage (Item_Nodes);        <--

     type Item_Storage_Type (<>) is
       new Item_Storage.Root_Storage_Type with private;

     Storage : in out Item_Storage_Type;

  package ACL.Stacks_Unbounded is ...;


Now we need to implement some storage pools.  We use a bounded storage
pool to implement a fixed-size, statically-allocated heap:

  generic

     Size : in Positive;

  package ACL.Storage.Bounded_G is

     type Bounded_Storage_Type is
       new Root_Storage_Type with private;

     procedure Allocate ...;

     procedure Deallocate ...;

  private

     ...

  end ACL.Storage.Bounded_G;


The bounded pool is implemented as an array of nodes with a pointer to
the first unused node:

   type Bounded_Storage_Type is
     new Root_Storage_Type with record
        Nodes : Storage_Node_Array (1 .. Size);
        Head  : Storage_Node_Access :=
          Initialize (Bounded_Storage_Type'Access);
     end record;

During elaboration, a bounded storage pool object initializes the free
list by setting each node to point to the next one in the array:

   function Initialize
     (Storage : access Bounded_Storage_Type)
     return Storage_Node_Access is
   begin

      for I in Positive range 1 .. Size - 1 loop

         Storage.Nodes (I).Next :=
           Storage.Nodes (I+1)'Access;

      end loop;

      return Storage.Nodes (1)'Access;

   end Initialize;


Note that we implement initialization of the storage pool using a
function called during elaboration, because this is less expensive than
using Ada.Finalization.

OK, now that we have a storage pool type, we can finally implement an
actual stack.  What we'll end up with will look something like this:

  package Integer_Stacks_Unbounded_Static is

     ...

     type Integer_Stack is
       new Stack_Type with null record;

  end Integer_Stacks_Unbounded_Static;


Before we can instantiate anything else, we need storage nodes:

   package Integer_Nodes is
     new ACL.Storage_Nodes (Integer);


We use the storage node type to instantiate the storage pool class:

   package Integer_Storage is
     new ACL.Storage (Integer_Nodes);


This gives us the abstract root type in the class.  We get the static
heap type by instantiating the bounded pool package:

   package Integer_Storage_Bounded is
     new Integer_Storage.Bounded_G (Size => 25);


With a storage pool type, we can declare a storage pool object:

   Storage : Bounded_Storage_Type;


We now have all the components we need to instantiate the stack package:

   package Stack_Types is
     new ACL.Stacks_Unbounded
     (Integer,
      Integer_Nodes,
      Integer_Storage,
      Bounded_Storage_Type,
      Storage);


The final step is to make one more derivation, so that stack operations
are directly visible in the outer package:

   type Integer_Stack is
     new Stack_Types.Stack_Type with null record;


We're done.  We now have a stack for integers, and each instance of the
stack has unbounded size.  Storage nodes for stack instances are drawn
from a pool that has has a bounded size.  No heap has been used, which
satisfies the needs of developers of safety-critical software.

Desktop systems can be written with heap, so we also provide an
unbounded pool:

  generic
  package ACL.Storage.Unbounded_G is

     type Unbounded_Storage_Type is
       new Root_Storage_Type with private;

     procedure Allocate ...;

     procedure Deallocate ...;

  private

    type Unbounded_Storage_Type is
      new Root_Storage_Type with record
         Head : Storage_Node_Access;
      end record;

  end ACL.Storage.Unbounded_G;


This is a very simple implementation that maintains a linked list of
unused nodes.  If the free list is empty, then it allocates a new node
off the heap; otherwise, it just returns a node off the free list.

We create an unbounded stack with a dynamic storage pool the same way we
did before, except that we use an unbounded pool:

   package Integer_Storage_Unbounded is
     new Integer_Storage.Unbounded_G;

   Storage : Unbounded_Storage_Type;

   package Stack_Types is
     new ACL.Stacks_Unbounded
     (Integer,
      Integer_Nodes,
      Integer_Storage,
      Unbounded_Storage_Type,  <--
      Storage);


We have created two different kinds of unbounded stacks, just by
parameterizing the package with a different storage pool strategy.


Implementation of the Concurrent Forms

In an earlier article we implemented a concurrent stack with a
semaphore, and used a controlled object to make sure the semaphore was
always released.

A more efficient technique is to implement the stack as a protected type
directly.  Protected subprograms are used to synchronize access to stack
data, instead of using an entry queue (Seize) to serialize threads.

We use a type adapter to import a sequential stack as a generic formal
type, and implement the concurrent stack as a protected type with the
imported stack as protected data:

  generic

     type Item_Type is private;

     type Stack_Rep is limited private;      <--

     with procedure Push
       (Item : in     Item_Type;
        On   : in out Stack_Rep) is <>;

     with procedure Pop
       (Stack : in out Stack_Rep) is <>;

     ...

  package ACL.Stacks_Concurrent is

     type Stack_Type is limited private;


     procedure Push
       (Item : in     Item_Type;
        On   : in out Stack_Type);

     procedure Pop
       (Stack : in out Stack_Type);

     ...

  private

     protected type Stack_Type is

        procedure Push (Item : in Item_Type);

        procedure Pop;

        ...

     private

        Rep : Stack_Rep;                 <--

     end Stack_Type;

  end ACL.Stacks_Concurrent;


Note that it doesn't matter what kind of (sequential) stack is imported;
it could be bounded or unbounded.  All the concurrent stack adapter
cares about is that the rep stack has the indicated operations.

I have chosen here to hide the fact that the concurrent stack is a
protected type, and have implemented public operations as call-throughs
to the underlying type:

   procedure Push
     (Item : in     Item_Type;
      On   : in out Stack_Type) is
   begin
      On.Push (Item);
   end;

   procedure Pop
     (Stack : in out Stack_Type) is
   begin
      Stack.Pop;
   end;


The protected type passes the calls down to its representation stack:

   protected body Stack_Type is

      procedure Push (Item : in Item_Type) is
      begin
         Push (Item, On => Rep);
      end;

      procedure Pop is
      begin
         Pop (Rep);
      end;

      ...

   end Stack_Type;


Is this the best way to do it?  I don't know.  Tucker Taft and Mark
Gerhardt have both made the observation that you should advertise the
concurrent semantics of an abstraction, as this facilitates formal
analysis.

In that case, you might decide to just publicly declare the concurrent
stack as a protected type:

  generic
     ...
  package ACL.Stacks_Concurrent is

     protected type Stack_Type is

        procedure Push (Item : in Item_Type);

        procedure Pop;

        function Get_Top return Item_Type;

        procedure Set_Top (Item  : in Item_Type);

        function Is_Empty return Boolean;

     private

        Rep : Stack_Rep;

     end Stack_Type;

  end ACL.Stacks_Concurrent;


Now that we have an adapter, we can start implementing concurrent
stacks.  Let's begin by implementing a concurrent bounded stack.

First we declare a bounded sequential stack, like we did before:

   package Stack_Types is
     new ACL.Stacks_Bounded (Integer, Max_Depth => 10);


Then we pass the sequential type to the concurrent stack adapter:

     use Stack_Types;

     package Concurrent_Stacks is
       new ACL.Stacks_Concurrent (Integer, Stack_Type);


Note that we used a use clause to make Stack_Type operations directly
visible; this simplifies the instantiation of the concurrent stacks
package, because all the formal subprograms take default values.

Finally, we make one more derivation, to effect transitivity of
visibility:

     type Integer_Stack is
       new Concurrent_Stacks.Stack_Type;


The completed spec looks like this:

  package Integer_Stacks_Bounded_Concurrent is

     package Stack_Types is
       new ACL.Stacks_Bounded (Integer, Max_Depth => 10);

     use Stack_Types;

     package Concurrent_Stacks is
       new ACL.Stacks_Concurrent (Integer, Stack_Type);

     type Integer_Stack is
       new Concurrent_Stacks.Stack_Type;

  end Integer_Stacks_Bounded_Concurrent;


In order to implement concurrent unbounded stacks, we're going to have
to create another concurrent adapter for storage pools.  Like the
adapter for stacks, this also uses a protected type, to synchronize
access to the storage pool:

  generic

     type Storage_Type is new Root_Storage_Type with private;

  package ACL.Storage.Concurrent_G is

     type Concurrent_Storage_Type is
        new Root_Storage_Type with private;

     procedure Allocate ...;

     procedure Deallocate ...;

  private

     protected type Synchronization_Type is

        procedure Allocate (Node : in out Storage_Node_Access);

        procedure Deallocate (Node : in out Storage_Node_Access);

     private

        Storage : Storage_Type;

     end Synchronization_Type;


     type Concurrent_Storage_Type is
       new Root_Storage_Type with record
          Synchronization : Synchronization_Type;
       end record;

  end ACL.Storage.Concurrent_G;


Note that we don't have to import generic formal operations for the
sequential storage type, because we're importing it as a formal tagged
type in the Root_Storage_Type class, and therefore we already know what
its operations are.

Let's take our sequential unbounded stack with the dynamic pool, and
make the storage pool concurrent.  As before, we start with an unbounded
pool:

     package Integer_Nodes is
       new ACL.Storage_Nodes (Integer);

     package Integer_Storage is
       new ACL.Storage (Integer_Nodes);

     package Integer_Storage_Unbounded is
       new Integer_Storage.Unbounded_G;


Next we adapt the sequential pool, to make it concurrent:

   package Integer_Storage_Unbounded_Concurrent is
     new Integer_Storage.Concurrent_G (Unbounded_Storage_Type);


Now that we have a concurrent storage type, we can declare a concurrent
storage pool object:

   Storage : Concurrent_Storage_Type;


We pass this concurrent storage pool object to the instantiation of the
(sequential) stack package.  The completed spec looks like this:

  package Integer_Stacks_Unbounded_Dynamic_Controlled is

     package Integer_Nodes is
       new ACL.Storage_Nodes (Integer);

     package Integer_Storage is
       new ACL.Storage (Integer_Nodes);

     package Integer_Storage_Unbounded is
       new Integer_Storage.Unbounded_G;

     package Integer_Storage_Unbounded_Concurrent is
       new Integer_Storage.Concurrent_G
       (Integer_Storage_Unbounded.Unbounded_Storage_Type);

     use Integer_Storage_Unbounded_Concurrent;

     Storage : Concurrent_Storage_Type;

     package Stack_Types is
       new ACL.Stacks_Unbounded
       (Integer,
        Integer_Nodes,
        Integer_Storage,
        Concurrent_Storage_Type,
        Storage);

     type Integer_Stack is
       new Stack_Types.Stack_Type with null record;

  end Integer_Stacks_Unbounded_Dynamic_Controlled;


This gives us controlled unbounded stacks.  We can create concurrent
unbounded stacks by taking what we have above, and just adapting the
sequential stack:

  package Integer_Stacks_Unbounded_Dynamic_Concurrent is

     ...

     use Stack_Types;

     package Concurrent_Stack_Types is
       new ACL.Stacks_Concurrent (Integer, Stack_Type);

     type Integer_Stack is
       new Concurrent_Stack_Types.Stack_Type;

  end Integer_Stacks_Unbounded_Dynamic_Concurrent;


Implementations of concurrent unbounded stacks that use a static heap
are implemented similarly.
	


--STX
package body ACL.Stacks_Bounded is


   procedure Push
     (Item : in     Item_Type;
      On   : in out Stack_Type) is
   begin
      On.Top := On.Top + 1;
      On.Items (On.Top) := Item;
   end;


   procedure Pop
     (Stack : in out Stack_Type) is
   begin
      Stack.Top := Stack.Top - 1;
   end;


   function Get_Top
     (Stack : Stack_Type) return Item_Type is
   begin
      return Stack.Items (Stack.Top);
   end;


   procedure Set_Top
     (Stack : in out Stack_Type;
      Item  : in     Item_Type) is
   begin
      Stack.Items (Stack.Top) := Item;
   end;


   function Is_Empty (Stack : Stack_Type) return Boolean is
   begin
      return Stack.Top = 0;
   end;


   procedure For_Every_Item (Stack : in out Stack_Type'Class) is

      Done : Boolean := False;

   begin

      for I in reverse 1 .. Stack.Top loop

         Process (Stack.Items (I), Done);

         exit when Done;

      end loop;

   end For_Every_Item;


end ACL.Stacks_Bounded;
generic

   type Item_Type is private;

   Max_Depth : in Positive;

package ACL.Stacks_Bounded is

   pragma Preelaborate;

   type Stack_Type is tagged limited private;


   procedure Push
     (Item : in     Item_Type;
      On   : in out Stack_Type);

   procedure Pop
     (Stack : in out Stack_Type);

   function Get_Top
     (Stack : Stack_Type) return Item_Type;

   procedure Set_Top
     (Stack : in out Stack_Type;
      Item  : in     Item_Type);

   function Is_Empty (Stack : Stack_Type) return Boolean;


   generic

      with procedure Process
        (Item : in out Item_Type;
         Done : in out Boolean);

   procedure For_Every_Item (Stack : in out Stack_Type'Class);

private

   subtype Item_Array_Range is Positive range 1 .. Max_Depth;

   type Item_Array is array (Item_Array_Range) of Item_Type;

   type Stack_Type is
      tagged limited record
         Items : Item_Array;
         Top   : Natural := 0;
      end record;

end ACL.Stacks_Bounded;
package body ACL.Stacks_Concurrent is

   procedure Push
     (Item : in     Item_Type;
      On   : in out Stack_Type) is
   begin
      On.Push (Item);
   end;

   procedure Pop
     (Stack : in out Stack_Type) is
   begin
      Stack.Pop;
   end;

   function Get_Top
     (Stack : Stack_Type) return Item_Type is
   begin
      return Stack.Get_Top;
   end;

   procedure Set_Top
     (Stack : in out Stack_Type;
      Item  : in     Item_Type) is
   begin
      Stack.Set_Top (Item);
   end;

   function Is_Empty
     (Stack : Stack_Type) return Boolean is
   begin
      return Stack.Is_Empty;
   end;

   protected body Stack_Type is

      procedure Push (Item : in Item_Type) is
      begin
         Push (Item, On => Rep);
      end;

      procedure Pop is
      begin
         Pop (Rep);
      end;

      function Get_Top return Item_Type is
      begin
         return Get_Top (Rep);
      end;

      procedure Set_Top (Item  : in Item_Type) is
      begin
         Set_Top (Rep, Item);
      end;

      function Is_Empty return Boolean is
      begin
         return Is_Empty (Rep);
      end;

   end Stack_Type;

end ACL.Stacks_Concurrent;
generic

   type Item_Type is private;

   type Stack_Rep is limited private;

   with procedure Push
     (Item : in     Item_Type;
      On   : in out Stack_Rep) is <>;

   with procedure Pop
     (Stack : in out Stack_Rep) is <>;

   with function Get_Top
     (Stack : Stack_Rep) return Item_Type is <>;

   with procedure Set_Top
     (Stack : in out Stack_Rep;
      Item  : in     Item_Type) is <>;

   with function Is_Empty
     (Stack : Stack_Rep) return Boolean is <>;

package ACL.Stacks_Concurrent is

   type Stack_Type is limited private;


   procedure Push
     (Item : in     Item_Type;
      On   : in out Stack_Type);

   procedure Pop
     (Stack : in out Stack_Type);

   function Get_Top
     (Stack : Stack_Type) return Item_Type;

   procedure Set_Top
     (Stack : in out Stack_Type;
      Item  : in     Item_Type);

   function Is_Empty
     (Stack : Stack_Type) return Boolean;

private

   protected type Stack_Type is

      procedure Push (Item : in Item_Type);

      procedure Pop;

      function Get_Top return Item_Type;

      procedure Set_Top (Item  : in Item_Type);

      function Is_Empty return Boolean;

   private

      Rep : Stack_Rep;

   end Stack_Type;

end ACL.Stacks_Concurrent;
package body ACL.Stacks_Unbounded is

   procedure Finalize (Control : in out Stack_Control) is

      Top  : Storage_Node_Access renames Control.Stack.Top;
      Node : Storage_Node_Access;

   begin

      while Top /= null loop

         Node := Top;

         Top := Top.Next;

         Deallocate (Storage, Node);

      end loop;

   end Finalize;


   procedure Push
     (Item : in     Item_Type;
      On   : in out Stack_Type) is

      Node : Storage_Node_Access;
   begin
      Allocate (Storage, Node);

      Node.Item := Item;
      Node.Next := On.Top;

      On.Top := Node;
   end Push;


   procedure Pop
     (Stack : in out Stack_Type) is

      Node : Storage_Node_Access := Stack.Top;
   begin
      Stack.Top := Stack.Top.Next;
      Deallocate (Storage, Node);
   end Pop;


   function Get_Top
     (Stack : Stack_Type) return Item_Type is
   begin
      return Stack.Top.Item;
   end;


   procedure Set_Top
     (Stack : in out Stack_Type;
      Item  : in     Item_Type) is
   begin
      Stack.Top.Item := Item;
   end;


   function Is_Empty (Stack : Stack_Type) return Boolean is
   begin
      return Stack.Top = null;
   end;


   procedure For_Every_Item (Stack : in out Stack_Type'Class) is

      Node : Storage_Node_Access := Stack.Top;
      Done : Boolean := False;
   begin
      while Node /= null loop
         Process (Node.Item, Done);
         exit when Done;
         Node := Node.Next;
      end loop;
   end For_Every_Item;


end ACL.Stacks_Unbounded;
with ACL.Storage_Nodes;
with ACL.Storage;
with Ada.Finalization;

generic

   type Item_Type is private;

   with package Item_Nodes is
    new Storage_Nodes (Item_Type);

   with package Item_Storage is
     new Storage (Item_Nodes);

   type Item_Storage_Type (<>) is
     new Item_Storage.Root_Storage_Type with private;

   Storage : in out Item_Storage_Type;

package ACL.Stacks_Unbounded is

   type Stack_Type is tagged limited private;


   procedure Push
     (Item : in     Item_Type;
      On   : in out Stack_Type);

   procedure Pop
     (Stack : in out Stack_Type);

   function Get_Top
     (Stack : Stack_Type) return Item_Type;

   procedure Set_Top
     (Stack : in out Stack_Type;
      Item  : in     Item_Type);

   function Is_Empty (Stack : Stack_Type) return Boolean;


   generic

      with procedure Process
        (Item : in out Item_Type;
         Done : in out Boolean);

   procedure For_Every_Item (Stack : in out Stack_Type'Class);

private

   use Item_Nodes;
   use Ada.Finalization;

   type Stack_Control (Stack : access Stack_Type) is
     new Limited_Controlled with null record;

   procedure Finalize (Control : in out Stack_Control);


   type Stack_Type is
      tagged limited record
         Top     : Storage_Node_Access;
         Control : Stack_Control (Stack_Type'Access);
      end record;

end ACL.Stacks_Unbounded;
package body ACL.Storage.Bounded_G is

   procedure Allocate
     (Storage : in out Bounded_Storage_Type;
      Node    :    out Storage_Node_Access) is
   begin

      if Storage.Head = null then
         raise Storage_Error;
      end if;

      Node := Storage.Head;
      Storage.Head := Storage.Head.Next;
      Node.Next := null;

   end Allocate;


   procedure Deallocate
     (Storage : in out Bounded_Storage_Type;
      Node    : in out Storage_Node_Access) is
   begin

      if Node /= null then

         Node.Next := Storage.Head;
         Storage.Head := Node;

      end if;

      Node := null;

   end Deallocate;


   function Initialize
     (Storage : access Bounded_Storage_Type)
     return Storage_Node_Access is
   begin

      for I in Positive range 1 .. Size - 1 loop

         Storage.Nodes (I).Next :=
           Storage.Nodes (I+1)'Access;

      end loop;

      return Storage.Nodes (1)'Access;

   end Initialize;


end ACL.Storage.Bounded_G;











generic

   Size : in Positive;

package ACL.Storage.Bounded_G is

   type Bounded_Storage_Type is
     new Root_Storage_Type with private;

   procedure Allocate
     (Storage : in out Bounded_Storage_Type;
      Node    :    out Storage_Node_Access);

   procedure Deallocate
     (Storage : in out Bounded_Storage_Type;
      Node    : in out Storage_Node_Access);

private

   type Storage_Node_Array is
      array (Positive range <>) of aliased Storage_Node;

   function Initialize
     (Storage : access Bounded_Storage_Type)
      return Storage_Node_Access;

   type Bounded_Storage_Type is
     new Root_Storage_Type with record
        Nodes : Storage_Node_Array (1 .. Size);
        Head  : Storage_Node_Access :=
          Initialize (Bounded_Storage_Type'Access);
     end record;

end ACL.Storage.Bounded_G;
package body ACL.Storage.Concurrent_G is

   procedure Allocate
     (Storage : in out Concurrent_Storage_Type;
      Node    :    out Storage_Node_Access) is
   begin
      Storage.Synchronization.Allocate (Node);
   end;

   procedure Deallocate
     (Storage : in out Concurrent_Storage_Type;
      Node    : in out Storage_Node_Access) is
   begin
      Storage.Synchronization.Deallocate (Node);
   end;


   protected body Synchronization_Type is

      procedure Allocate (Node : in out Storage_Node_Access) is
      begin
         Allocate (Storage, Node);
      end;

      procedure Deallocate (Node : in out Storage_Node_Access) is
      begin
         Deallocate (Storage, Node);
      end;

   end Synchronization_Type;


end ACL.Storage.Concurrent_G;

generic

   type Storage_Type is new Root_Storage_Type with private;

package ACL.Storage.Concurrent_G is

   type Concurrent_Storage_Type is
      new Root_Storage_Type with private;

   procedure Allocate
     (Storage : in out Concurrent_Storage_Type;
      Node    :    out Storage_Node_Access);

   procedure Deallocate
     (Storage : in out Concurrent_Storage_Type;
      Node    : in out Storage_Node_Access);

private

   protected type Synchronization_Type is

      procedure Allocate (Node : in out Storage_Node_Access);

      procedure Deallocate (Node : in out Storage_Node_Access);

   private

      Storage : Storage_Type;

   end Synchronization_Type;


   type Concurrent_Storage_Type is
     new Root_Storage_Type with record
        Synchronization : Synchronization_Type;
     end record;

end ACL.Storage.Concurrent_G;

package body ACL.Storage.Unbounded_G is

   procedure Allocate
     (Storage : in out Unbounded_Storage_Type;
      Node    :    out Storage_Node_Access) is
   begin

      if Storage.Head = null then

         Node := new Storage_Node;

      else

         Node := Storage.Head;
         Storage.Head := Storage.Head.Next;
         Node.Next := null;

      end if;

   end Allocate;


   procedure Deallocate
     (Storage : in out Unbounded_Storage_Type;
      Node    : in out Storage_Node_Access) is
   begin

      if Node /= null then

         Node.Next := Storage.Head;
         Storage.Head := Node;

      end if;

      Node := null;

   end Deallocate;


end ACL.Storage.Unbounded_G;
generic
package ACL.Storage.Unbounded_G is

   type Unbounded_Storage_Type is
     new Root_Storage_Type with private;

   procedure Allocate
     (Storage : in out Unbounded_Storage_Type;
      Node    :    out Storage_Node_Access);

   procedure Deallocate
     (Storage : in out Unbounded_Storage_Type;
      Node    : in out Storage_Node_Access);

private

  type Unbounded_Storage_Type is
    new Root_Storage_Type with record
       Head : Storage_Node_Access;
    end record;

end ACL.Storage.Unbounded_G;
with ACL.Storage_Nodes;

generic

   with package Nodes is new Storage_Nodes (<>);

package ACL.Storage is

   use Nodes;

   type Root_Storage_Type is abstract tagged limited null record;

   procedure Allocate
     (Storage : in out Root_Storage_Type;
      Node    :    out Storage_Node_Access) is abstract;

   procedure Deallocate
     (Storage : in out Root_Storage_Type;
      Node    : in out Storage_Node_Access) is abstract;

end ACL.Storage;








generic

   type Item_Type is limited private;

package ACL.Storage_Nodes is

   type Storage_Node;
   type Storage_Node_Access is access all Storage_Node;

   type Storage_Node is
      limited record
         Item : aliased Item_Type;
         Next : Storage_Node_Access;
         Prev : Storage_Node_Access;
      end record;

end ACL.Storage_Nodes;


package ACL is

   pragma Pure;

end ACL;
with ACL.Stacks_Bounded;

package Integer_Stacks_Bounded is
  new ACL.Stacks_Bounded (Integer, Max_Depth => 10);

with ACL.Stacks_Bounded;
with ACL.Stacks_Concurrent;

pragma Elaborate (ACL.Stacks_Bounded);
pragma Elaborate (ACL.Stacks_Concurrent);

package Integer_Stacks_Bounded_Concurrent is

   package Stack_Types is
     new ACL.Stacks_Bounded (Integer, Max_Depth => 10);

   use Stack_Types;

   package Concurrent_Stacks is
     new ACL.Stacks_Concurrent (Integer, Stack_Type);

   type Integer_Stack is
     new Concurrent_Stacks.Stack_Type;

end Integer_Stacks_Bounded_Concurrent;



with ACL.Storage_Nodes;
with ACL.Storage.Unbounded_G;
with ACL.Stacks_Unbounded;

pragma Elaborate (ACL.Storage_Nodes);
pragma Elaborate (ACL.Storage.Unbounded_G);
pragma Elaborate (ACL.Stacks_Unbounded);

package Integer_Stacks_Unbounded_Dynamic is

   package Integer_Nodes is
     new ACL.Storage_Nodes (Integer);

   package Integer_Storage is
     new ACL.Storage (Integer_Nodes);

   package Integer_Storage_Unbounded is
     new Integer_Storage.Unbounded_G;

   use Integer_Storage_Unbounded;

   Storage : Unbounded_Storage_Type;

   package Stack_Types is
     new ACL.Stacks_Unbounded
     (Integer,
      Integer_Nodes,
      Integer_Storage,
      Unbounded_Storage_Type,
      Storage);

   type Integer_Stack is
     new Stack_Types.Stack_Type with null record;

end Integer_Stacks_Unbounded_Dynamic;
with ACL.Storage_Nodes;
with ACL.Storage.Unbounded_G;
with ACL.Storage.Concurrent_G;
with ACL.Stacks_Unbounded;
with ACL.Stacks_Concurrent;

pragma Elaborate (ACL.Storage_Nodes);
pragma Elaborate (ACL.Storage.Unbounded_G);
pragma Elaborate (ACL.Storage.Concurrent_G);
pragma Elaborate (ACL.Stacks_Unbounded);
pragma Elaborate (ACL.Stacks_Concurrent);

package Integer_Stacks_Unbounded_Dynamic_Concurrent is

   package Integer_Nodes is
     new ACL.Storage_Nodes (Integer);

   package Integer_Storage is
     new ACL.Storage (Integer_Nodes);

   package Integer_Storage_Unbounded is
     new Integer_Storage.Unbounded_G;

   package Integer_Storage_Unbounded_Concurrent is
     new Integer_Storage.Concurrent_G
     (Integer_Storage_Unbounded.Unbounded_Storage_Type);

   use Integer_Storage_Unbounded_Concurrent;

   Storage : Concurrent_Storage_Type;

   package Stack_Types is
     new ACL.Stacks_Unbounded
     (Integer,
      Integer_Nodes,
      Integer_Storage,
      Concurrent_Storage_Type,
      Storage);

   use Stack_Types;

   package Concurrent_Stack_Types is
     new ACL.Stacks_Concurrent (Integer, Stack_Type);

   type Integer_Stack is
     new Concurrent_Stack_Types.Stack_Type;

end Integer_Stacks_Unbounded_Dynamic_Concurrent;
with ACL.Storage_Nodes;
with ACL.Storage.Unbounded_G;
with ACL.Storage.Concurrent_G;
with ACL.Stacks_Unbounded;

pragma Elaborate (ACL.Storage_Nodes);
pragma Elaborate (ACL.Storage.Unbounded_G);
pragma Elaborate (ACL.Storage.Concurrent_G);
pragma Elaborate (ACL.Stacks_Unbounded);

package Integer_Stacks_Unbounded_Dynamic_Controlled is

   package Integer_Nodes is
     new ACL.Storage_Nodes (Integer);

   package Integer_Storage is
     new ACL.Storage (Integer_Nodes);

   package Integer_Storage_Unbounded is
     new Integer_Storage.Unbounded_G;

   package Integer_Storage_Unbounded_Concurrent is
     new Integer_Storage.Concurrent_G
     (Integer_Storage_Unbounded.Unbounded_Storage_Type);

   use Integer_Storage_Unbounded_Concurrent;

   Storage : Concurrent_Storage_Type;

   package Stack_Types is
     new ACL.Stacks_Unbounded
     (Integer,
      Integer_Nodes,
      Integer_Storage,
      Concurrent_Storage_Type,
      Storage);

   type Integer_Stack is
     new Stack_Types.Stack_Type with null record;

end Integer_Stacks_Unbounded_Dynamic_Controlled;
with ACL.Storage_Nodes;
with ACL.Storage.Bounded_G;
with ACL.Stacks_Unbounded;

pragma Elaborate (ACL.Storage_Nodes);
pragma Elaborate (ACL.Storage.Bounded_G);
pragma Elaborate (ACL.Stacks_Unbounded);

package Integer_Stacks_Unbounded_Static is

   package Integer_Nodes is
     new ACL.Storage_Nodes (Integer);

   package Integer_Storage is
     new ACL.Storage (Integer_Nodes);

   package Integer_Storage_Bounded is
     new Integer_Storage.Bounded_G (Size => 25);

   use Integer_Storage_Bounded;

   Storage : Bounded_Storage_Type;

   package Stack_Types is
     new ACL.Stacks_Unbounded
     (Integer,
      Integer_Nodes,
      Integer_Storage,
      Bounded_Storage_Type,
      Storage);

   type Integer_Stack is
     new Stack_Types.Stack_Type with null record;

end Integer_Stacks_Unbounded_Static;
with ACL.Storage_Nodes;
with ACL.Storage.Bounded_G;
with ACL.Storage.Concurrent_G;
with ACL.Stacks_Unbounded;
with ACL.Stacks_Concurrent;

pragma Elaborate (ACL.Storage_Nodes);
pragma Elaborate (ACL.Storage.Bounded_G);
pragma Elaborate (ACL.Storage.Concurrent_G);
pragma Elaborate (ACL.Stacks_Unbounded);
pragma Elaborate (ACL.Stacks_Concurrent);

package Integer_Stacks_Unbounded_Static_Concurrent is

   package Integer_Nodes is
     new ACL.Storage_Nodes (Integer);

   package Integer_Storage is
     new ACL.Storage (Integer_Nodes);

   package Integer_Storage_Bounded is
     new Integer_Storage.Bounded_G (Size => 25);

   package Integer_Storage_Bounded_Concurrent is
     new Integer_Storage.Concurrent_G
     (Integer_Storage_Bounded.Bounded_Storage_Type);

   use Integer_Storage_Bounded_Concurrent;

   Storage : Concurrent_Storage_Type;

   package Stack_Types is
     new ACL.Stacks_Unbounded
     (Integer,
      Integer_Nodes,
      Integer_Storage,
      Concurrent_Storage_Type,
      Storage);

   use Stack_Types;

   package Concurrent_Stack_Types is
     new ACL.Stacks_Concurrent (Integer, Stack_Type);

   type Integer_Stack is
     new Concurrent_Stack_Types.Stack_Type;

end Integer_Stacks_Unbounded_Static_Concurrent;
with ACL.Storage_Nodes;
with ACL.Storage.Bounded_G;
with ACL.Storage.Concurrent_G;
with ACL.Stacks_Unbounded;

pragma Elaborate (ACL.Storage_Nodes);
pragma Elaborate (ACL.Storage.Bounded_G);
pragma Elaborate (ACL.Storage.Concurrent_G);
pragma Elaborate (ACL.Stacks_Unbounded);

package Integer_Stacks_Unbounded_Static_Controlled is

   package Integer_Nodes is
     new ACL.Storage_Nodes (Integer);

   package Integer_Storage is
     new ACL.Storage (Integer_Nodes);

   package Integer_Storage_Bounded is
     new Integer_Storage.Bounded_G (Size => 25);

   package Integer_Storage_Bounded_Concurrent is
     new Integer_Storage.Concurrent_G
     (Integer_Storage_Bounded.Bounded_Storage_Type);

   use Integer_Storage_Bounded_Concurrent;

   Storage : Concurrent_Storage_Type;

   package Stack_Types is
     new ACL.Stacks_Unbounded
     (Integer,
      Integer_Nodes,
      Integer_Storage,
      Concurrent_Storage_Type,
      Storage);

   type Integer_Stack is
     new Stack_Types.Stack_Type with null record;

end Integer_Stacks_Unbounded_Static_Controlled;
with Integer_Stacks_Bounded;
with Integer_Stacks_Bounded_Concurrent;
with Integer_Stacks_Unbounded_Static;
with Integer_Stacks_Unbounded_Static_Controlled;
with Integer_Stacks_Unbounded_Static_Concurrent;
with Integer_Stacks_Unbounded_Dynamic;
with Integer_Stacks_Unbounded_Dynamic_Controlled;
with Integer_Stacks_Unbounded_Dynamic_Concurrent;

procedure Test_Stacks is
begin
   null;
end Test_Stacks;


(c) 1998-2004 All Rights Reserved David Botton