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;
|
