kpierce@umn-d-ub.D.UMN.EDU (Keith Pierce) (03/28/90)
I am developing software components a la Grady Booch (SOFTWARE COMPONENTS WITH
ADA, Benjamin Cummings 1987), but am having trouble with the concurrent
version of queues. Booch uses semaphores hidden in the structure to guarantee
that only one task at a time is actively processing a queue. However, when I
activate several tasks to simultaneously update a queue, strange results
ensue. I appeal to experts in Ada tasking and/or Booch components to help me
determine whether it's my fault or the compilers (I am using Verdix Ada, as
ported to Encore Multimax, a multiprocessor Unix machine, and thus supports
true concurrency).
To simplify your task, I have written a simple version of my original program,
that uses semaphores to protect an integer variable from simultaneous update.
The program defines a package that defines a protected natural variable type
and a single operation that adds one to the variable.
The main program defines two tasks that simultaneously try to update the
variable each 10 times. If correctly working, the variable's value at the end
should be 20, but it ends up being 10.
Here are the pieces of the program. Each piece delimited by dashes resides in
a separate file.
---------------------------------------------------------------
-- Specification of Semaphores
-- Reference: Booch
---------------------------------------------------------------
package Semaphore is
type Kind is limited private;
procedure Seize (The_Semaphore : in Kind);
procedure Release (The_Semaphore : in Kind);
private
task type Kind is
entry Seize;
entry Release;
end Kind;
end Semaphore;
----------------------------------------------------------------
-- Body of semaphore package.
-- Reference: Booch
----------------------------------------------------------------
package body Semaphore is
task body Kind is
In_Use : Boolean := False;
begin
loop
select
when not In_Use =>
accept Seize;
In_Use := True;
or
when In_Use =>
accept Release;
In_Use := False;
or
terminate;
end select;
end loop;
end Kind;
procedure Seize (The_Semaphore : in Kind) is
begin
The_Semaphore.Seize;
end Seize;
procedure Release (The_Semaphore : in Kind) is
begin
The_Semaphore.Release;
end Release;
end Semaphore;
--------------------------------------------------------------
-- Specification of package Nat_Package
-- Defines an abstract type of object "Protected_Natural"
-- Objects declared of this type have initial value zero.
-- Operaton "Add_One" increments the object by one.
-- Operation "Put" outputs the value to standard output
-- Semaphores are used to protect against simultaneous access
--------------------------------------------------------------
with Semaphore;
package Nat_Package is
type Protected_Natural is limited private;
procedure Add_One (To_Number : in out Protected_Natural);
procedure Put (The_Number : in Protected_Natural);
private
type Protected_Natural is
record
The_Value : Natural := 0;
Guard : Semaphore.Kind;
end record;
end Nat_Package;
--------------------------------------------------------------
-- Body of package Nat_Package.
--------------------------------------------------------------
with Semaphore;
with Text_Io; use Text_Io;
package body Nat_Package is
package Natural_Io is new Text_Io.Integer_Io(Natural); use Natural_Io;
procedure Add_One (To_Number : in out Protected_Natural) is
begin
Semaphore.Seize (To_Number.Guard);
To_Number.The_Value := To_Number.The_Value + 1;
Put("Adding one, new value is");
Put (To_Number.The_Value, width => 1);
New_Line;
Semaphore.Release (To_Number.Guard);
end Add_One;
procedure Put (The_Number : in Protected_Natural) is
begin
Natural_Io.Put (The_Number.The_Value, width => 1);
end Put;
end Nat_Package;
------------------------------------------------------------
-- Main program Par_Test
-- Declares a global object of type Protected_Natural
-- and two tasks, Add1 and Add2, that, when activated by
-- calling entry Start, each add one to Counter 10 times.
-- When done (as signaled by "Signal_Done" rendesvous with
-- main program), main program prints the final value.
-- It should be 20, but is 10.
-----------------------------------------------------------
with Text_io,
Nat_Package; use Text_Io; use Nat_Package;
procedure Par_Test is
package Natural_Io is new Integer_Io(Natural); use Natural_Io;
task type Adder is
entry Start (How_Many : in Natural);
entry Signal_Done;
end Adder;
Counter : Protected_Natural;
Add1, Add2 : Adder;
-- Note that task body accesses Counter globally
task body Adder is
Limit : Natural;
begin
accept Start(How_Many : in Natural) do
Limit := How_Many;
end Start;
for Index in 1..Limit loop
Nat_Package.Add_One (To_Number => Counter);
end loop;
accept Signal_Done;
end Adder;
begin
Add1.Start(10);
Add2.Start(10);
Add1.Signal_Done;
Add2.Signal_Done;
Put ("The final value of Counter is ");
Nat_Package.Put (Counter);
end Par_test;
--------------------------------------------------------------
--------------------------------------------------------------
-- Here is a script of the output of this program.
--------------------------------------------------------------
--------------------------------------------------------------
Adding one, new value is1
Adding one, new value is1
Adding one, new value is2
Adding one, new value is2
Adding one, new value is3
Adding one, new value is3
Adding one, new value is4
Adding one, new value is4
Adding one, new value is5
Adding one, new value is5
Adding one, new value is6
Adding one, new value is6
Adding one, new value is7
Adding one, new value is7
Adding one, new value is8
Adding one, new value is8
Adding one, new value is9
Adding one, new value is9
Adding one, new value is10
Adding one, new value is10
The final value of Counter is 10