In the last article, I implemented the semaphore type as limited
private, hiding the fact that the semaphore was a protected type.
I've been thinking more about that declaration, and have come to the
tentative conclusion that it's better to just state publicly that the
semaphore is a protected object.
The revised type declaration looks like this:
package Binary_Semaphores is
pragma Pure;
protected type Semaphore_Type is
procedure Release;
entry Seize;
private
In_Use : Boolean := False;
end Semaphore_Type;
end Binary_Semaphores;
There are a few reasons for taking this point of view:
o Clients can't violate the abstraction anyway, even if it's not limited
private, because a protected type still hides the representation.
o You can make timed and conditional entry calls to a protected entry:
select
Semaphore.Seize;
or
delay 5.0;
<handle timeout>
end select;
select
Semaphore.Seize;
else
<do something else instead of waiting>
end select;
If this is intended as a reusable component, then you want it to be as
flexible as possible. If you hide the representation of the semaphore,
timed or conditional entry calls aren't possible.
o It's kind of nice to advertise the fact that Seize is a blocking call,
instead of making it look like any other kind of operation. Instead of
Seize (Semaphore);
it's better to say
Semaphore.Seize;
The "distinguished receiver" syntax emphasizes the fact that this is a
synchronizing operation.
I'm inspired here by comments made by Tucker a couple of years ago:
(start of post by Tucker Taft)
Re: Syntax for tagged record types and class types
Author: Tucker Taft <stt@houdini.camb.inmet.com>
Date: 1997/05/27
Forum: comp.lang.ada
Prefix notation, by which I mean <object>.<operation>, is reserved in
Ada 95 for calls on "synchronizing" operations. The prefix object is
the one controlling the synchronization. Hence, prefix notation is used
for task entry calls, and protected operation calls only. In each of
these cases, the prefix object is very special -- one must enter the
synchronization domain of the prefix object before the operation is
performed. Even if there are multiple parameters of the same task or
protected type passed to the operation, the synchronization is
associated only with the prefix object.
For non-synchronizing operations, all parameters are treated
symmetrically, and so the "principle of uniform reference" would argue
that all such parameters belong inside the parentheses, rather than
dangling out front.
[snip]
-Tucker Taft stt@inmet.com http://www.inmet.com/~stt/
Intermetrics, Inc. Burlington, MA USA
(end of post by Tucker Taft)
If we assume clients are going to be using timed or conditional calls,
then we can also assume they are doing something more sophisticated than
declaring a Semaphore_Control object.
For this reason, I decided to move the Semaphore_Control type off into
its own child package. This way clients who aren't using that type
don't have to have a dependency on Ada.Finalization, and as a bonus we
can declare the Binary_Semaphores package as pragma Pure.
Clients who do decide to use the Semaphore_Control type just with that
package in the body:
with Binary_Semaphores.Controls; use Binary_Semaphores.Controls;
with System.Address_To_Access_Conversions;
pragma Elaborate_All (System.Address_To_Access_Conversions);
package body Stacks is ...;
--STX
package body Binary_Semaphores.Controls is
procedure Initialize (Control : in out Semaphore_Control) is
begin
Control.Semaphore.Seize;
end;
procedure Finalize (Control : in out Semaphore_Control) is
begin
Control.Semaphore.Release;
end;
end Binary_Semaphores.Controls;
with Ada.Finalization;
package Binary_Semaphores.Controls is
pragma Preelaborate;
type Semaphore_Control (Semaphore : access Semaphore_Type) is
limited private;
private
use Ada.Finalization;
type Semaphore_Control (Semaphore : access Semaphore_Type) is
new Limited_Controlled with null record;
procedure Initialize (Control : in out Semaphore_Control);
procedure Finalize (Control : in out Semaphore_Control);
end Binary_Semaphores.Controls;
package body Binary_Semaphores is
protected body Semaphore_Type is
procedure Release is
begin
In_Use := False;
end;
entry Seize when not In_Use is
begin
In_Use := True;
end;
end Semaphore_Type;
end Binary_Semaphores;
package Binary_Semaphores is
pragma Pure;
protected type Semaphore_Type is
procedure Release;
entry Seize;
private
In_Use : Boolean := False;
end Semaphore_Type;
end Binary_Semaphores;
with Binary_Semaphores.Controls; use Binary_Semaphores.Controls;
with System.Address_To_Access_Conversions;
pragma Elaborate_All (System.Address_To_Access_Conversions);
package body Stacks is
package Addr_To_Acc_Conversions is
new System.Address_To_Access_Conversions (Stack_Type);
procedure Push
(Item : in Item_Type;
On : in out Stack_Type) is
Control : Semaphore_Control (On.Sema'Access);
begin
On.Top := On.Top + 1;
On.Items (On.Top) := Item;
end;
procedure Pop
(Stack : in out Stack_Type) is
Control : Semaphore_Control (Stack.Sema'Access);
begin
Stack.Top := Stack.Top - 1;
end;
function Get_Top
(Stack : Stack_Type) return Item_Type is
use Addr_To_Acc_Conversions;
SA : constant Object_Pointer :=
To_Pointer (Stack'Address);
Control : Semaphore_Control (SA.Sema'Access);
begin
return SA.Items (SA.Top);
end Get_Top;
procedure Set_Top
(Stack : in out Stack_Type;
Item : in Item_Type) is
Control : Semaphore_Control (Stack.Sema'Access);
begin
Stack.Items (Stack.Top) := Item;
end;
procedure For_Every_Item (Stack : in out Stack_Type) is
Control : Semaphore_Control (Stack.Sema'Access);
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 Stacks;
with Binary_Semaphores;
generic
type Item_Type is private;
Max_Depth : in Positive;
package Stacks is
pragma Preelaborate;
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);
generic
with procedure Process
(Item : in out Item_Type;
Done : in out Boolean);
procedure For_Every_Item (Stack : in out Stack_Type);
private
subtype Item_Array_Range is Positive range 1 .. Max_Depth;
type Item_Array is array (Item_Array_Range) of Item_Type;
use Binary_Semaphores;
type Stack_Type is
limited record
Items : Item_Array;
Top : Natural := 0;
Sema : aliased Semaphore_Type;
end record;
end Stacks;
|
