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;

Contributed by: Matthew Heaney

Contributed on: May 24, 1999

License: Public Domain

Back