In this variation of the Observer pattern, we declare a concurrent
subject and show how to properly synchronize communication between the
subject and its observers.
Our main concern here is that we have to be careful how the observer
gets the subject's data, in order to avoid deadlock and ensure that the
entire state is coherent (because hour, minute, and second are a matched
set).
First, let's show how to implement the subject. For reasons I'll
explain later, we declare the partial view of the Clock_Timer subject as
a limited private abstraction:
package Clock_Timers is
type Clock_Timer is limited private;
private
...
end Clock_Timers;
There are no public selector functions to query the state, which means
we intend that observer types will be declared in child packages, so
they have access to the subject's representation (which contains the
state data).
The Clock_Timer is concurrent, which means a task is involved somehow.
What we do is privately derive Clock_Timer from Subject_Type, and extend
it with a task component:
package Clock_Timers is
type Clock_Timer is limited private;
private
...
task type Timer_Task_Type (Timer : access Clock_Timer);
type Clock_Timer is
new Subject_Type with record
Hour : Hour_Number;
Minute : Minute_Number;
Second : Second_Number;
Semaphore : aliased Semaphore_Type;
Timer_Task : Timer_Task_Type (Clock_Timer'Access);
end record;
end Clock_Timers;
Instead of a public Tick operation to update the time, the subject will
update itself, automatically updating the time once per second, and then
notifying its observers.
The task component has an access discriminant, which binds the task to
the "current instance" of the Clock_Timer. This is how the task sees
the Hour, Minute, and Second components of the enclosing record.
It's the task-part of the subject that notifies the observers.
Therefore, we can't put the state data inside the task (providing an
entry to get it), because while the task is calling Notify, it's not
able to accept any entries.
That's why we put the subject's state data outside its task, so that it
would be directly accessible to observers. However, because the state
data isn't protected by a synchronization primitive, the subject and its
observers have to agree to a proper time to access the data, in order to
ensure that it's coherent.
So we make the rule that an observer is only allowed to access the
subject's state during an Update. This is one of the reasons why we
made the observer(s) a child of the subject. Had query functions been
declared publicly (in the spec) of the subject, then it with would have
no way of controlling when those selectors get called by clients that
aren't observers.
The Clock_Timer also contains a semaphore component to synchronize
access to the actual subject-part, i.e. the observer list itself. The
issue is that the Clock_Timer can't control exactly when observers will
Attach and Detach themselves. If this were to happen while the
task-part was iterating through the observer list during a Notify, then
the list could become corrupted.
Therefore, we make another rule that says an observer can Attach or
Detach itself only after Seize'ing the Semaphore, and the subject can
Notify observers only after Seize'ing the Semaphore. This synchronizes
concurrent access to the subject-part (observer list) of the
Clock_Timer.
The task-part of the Clock_Timer is implemented this way:
task body Timer_Task_Type is
Current_Time : Natural := 1 * 3600 + 59 * 60 + 55;
begin
Main:
for I in 1 .. 20 loop
delay 1.0;
Current_Time := Current_Time + 1;
-- Update time and notify observers.
Do_Tick (Timer, Time => Current_Time);
end loop Main;
end Timer_Task_Type;
Basically, the task wakes up once a second, updates the time, and then
notifies its observers.
We said that the subject would only do the Notify after Seize'ing the
Semaphore. That part of the operation is done in Do_Tick:
procedure Do_Tick
(Timer : access Clock_Timer;
Time : in Natural) is
Control : Semaphore_Control (Timer.Semaphore'Access);
<calculate new values of Hour, Min, and Sec>
begin
Timer.Hour := Hour;
Timer.Minute := Minute;
Timer.Second := Second;
Notify (Timer.all);
end Do_Tick;
We use a Semaphore_Control object to automatically call Seize and
Release during elaboration and finalization. This ensures that no
matter how we leave the subprogram, the Semaphore gets Release'd.
You may be wondering why we used a Semaphore to synchronize access to
the
subject-part, instead of wrapping a subject object inside a protected
object.
The subject has no way of knowing what an observer does during Update,
which may include blocking operations (very likely, because observers
often perform I/O to display subject state). The problem is that
blocking calls are illegal from inside a protected operation.
This means we can't use the monitor idiom for synchronization, because
that would prevent observers from making blocking calls. So we use a
semaphore to synchronize access, which doesn't have this limitation.
Of course, semaphores are dangerous in comparison to monitors, because
you may follow an execution path in which the semaphore doesn't get
released, which will almost certainly result in deadlock. For example,
an observer may inadvertently raise an exception during Update, which
would propagate out of Notify, and past the Release statement. That's
why we used a Semaphore_Control object.
That's about it for the Clock_Timer subject. Now let's discuss the
Digital_Clock observer. Here we implement the type as a child of the
Clock_Timers package, with a Control discriminant to automatically
Attach to the subject during elaboration, and Detach during
finalization.
You've seen the spec before, so I won't repeat it here. The interesting
part of the body is that, during the Controlled operations Initialize
and Finalize, we have to seize and release the subject's internal
semaphore. This is to prevent corruption of the observer list while the
subject is notifying existing observers.
The Digital_Clock's Initialize operation looks like this:
procedure Initialize
(Control : in out Control_Type) is
Clock : Digital_Clock renames Control.Clock.all;
Timer : Clock_Timer renames Clock.Timer.all;
Sema_Control : Semaphore_Control (Timer.Semaphore'Access);
begin
Attach (Clock, To => Timer);
end;
As we do elsewhere, we use a Semaphore_Control object to do the Seize
and Release automatically. Finalize is implemented similarly, except
that it calls Detach.
--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 Ada.Text_IO; use Ada.Text_IO;
package body Clock_Timers.Digital_Clocks is
procedure Initialize
(Control : in out Control_Type) is
Clock : Digital_Clock renames Control.Clock.all;
Timer : Clock_Timer renames Clock.Timer.all;
Sema_Control : Semaphore_Control (Timer.Semaphore'Access);
begin
Attach (Clock, To => Timer);
end;
procedure Finalize
(Control : in out Control_Type) is
Clock : Digital_Clock renames Control.Clock.all;
Timer : Clock_Timer renames Clock.Timer.all;
Sema_Control : Semaphore_Control (Timer.Semaphore'Access);
begin
Detach (Clock, From => Timer);
end;
procedure Update (Clock : access Digital_Clock) is
Hour_Image : constant String :=
Integer'Image (Clock.Timer.Hour + 100);
Minute_Image : constant String :=
Integer'Image (Clock.Timer.Minute + 100);
Second_Image : constant String :=
Integer'Image (Clock.Timer.Second + 100);
Clock_Image : constant String :=
Hour_Image (3 .. Hour_Image'Last) & ":" &
Minute_Image (3 .. Minute_Image'Last) & ":" &
Second_Image (3 .. Second_Image'Last);
begin
Put_Line (Clock_Image);
end Update;
end Clock_Timers.Digital_Clocks;
with Ada.Finalization;
with Subjects_And_Observers;
package Clock_Timers.Digital_Clocks is
type Digital_Clock (Timer : access Clock_Timer) is
limited private;
private
use Ada.Finalization;
type Control_Type (Clock : access Digital_Clock) is
new Limited_Controlled with null record;
procedure Initialize
(Control : in out Control_Type);
procedure Finalize
(Control : in out Control_Type);
use Subjects_And_Observers;
type Digital_Clock (Timer : access Clock_Timer) is
new Observer_Type with record
Control : Control_Type (Digital_Clock'Access);
end record;
procedure Update
(Clock : access Digital_Clock);
end Clock_Timers.Digital_Clocks;
with Binary_Semaphores.Controls; use Binary_Semaphores.Controls;
package body Clock_Timers is
procedure Do_Tick
(Timer : access Clock_Timer;
Time : in Natural) is
Control : Semaphore_Control (Timer.Semaphore'Access);
Hour : constant Hour_Number :=
Time / 3600;
Minute : constant Minute_Number :=
(Time - 3600 * Hour) / 60;
Second : constant Second_Number :=
Time -
3600 * Hour -
60 * Minute;
begin
Timer.Hour := Hour;
Timer.Minute := Minute;
Timer.Second := Second;
Notify (Timer.all);
end Do_Tick;
task body Timer_Task_Type is
Current_Time : Natural := 1 * 3600 + 59 * 60 + 55;
begin
Main:
for I in 1 .. 20 loop
delay 1.0;
Current_Time := Current_Time + 1;
Do_Tick (Timer, Time => Current_Time);
end loop Main;
end Timer_Task_Type;
end Clock_Timers;
with Binary_Semaphores;
with Subjects_And_Observers; use Subjects_And_Observers;
package Clock_Timers is
type Clock_Timer is limited private;
private
subtype Hour_Number is
Natural range 0 .. 23;
subtype Minute_Number is
Natural range 0 .. 59;
subtype Second_Number is
Natural range 0 .. 59;
task type Timer_Task_Type (Timer : access Clock_Timer);
use Binary_Semaphores;
type Clock_Timer is
new Subject_Type with record
Hour : Hour_Number;
Minute : Minute_Number;
Second : Second_Number;
Semaphore : aliased Semaphore_Type;
Timer_Task : Timer_Task_Type (Clock_Timer'Access);
end record;
end Clock_Timers;
package body Subjects_And_Observers is
procedure Notify (Subject : in out Subject_Type'Class) is
Observer : Observer_Access := Subject.Head;
begin
while Observer /= null loop
Update (Observer);
Observer := Observer.Next;
end loop;
end Notify;
procedure Attach
(Observer : in out Observer_Type'Class;
To : in out Subject_Type'Class) is
begin
Observer.Next := To.Head;
To.Head := Observer'Unchecked_Access;
end;
procedure Detach
(Observer : in out Observer_Type'Class;
From : in out Subject_Type'Class) is
OA : constant Observer_Access :=
Observer'Unchecked_Access;
Prev : Observer_Access;
Index : Observer_Access;
begin
if From.Head = OA then
From.Head := From.Head.Next;
else
Prev := From.Head;
Index := From.Head.Next;
while Index /= OA loop
Prev := Index;
Index := Index.Next;
end loop;
Prev.Next := Index.Next;
end if;
end Detach;
end Subjects_And_Observers;
package Subjects_And_Observers is
type Subject_Type is
tagged limited private;
procedure Notify
(Subject : in out Subject_Type'Class);
type Observer_Type is
abstract tagged limited private;
procedure Update
(Observer : access Observer_Type) is abstract;
procedure Attach
(Observer : in out Observer_Type'Class;
To : in out Subject_Type'Class);
procedure Detach
(Observer : in out Observer_Type'Class;
From : in out Subject_Type'Class);
private
type Observer_Access is access all Observer_Type'Class;
-- pragma Suppress (Access_Check, On => Observer_Access);
for Observer_Access'Storage_Size use 0;
type Subject_Type is
tagged limited record
Head : Observer_Access;
end record;
type Observer_Type is
abstract tagged limited record
Next : Observer_Access;
end record;
end Subjects_And_Observers;
with Clock_Timers; use Clock_Timers;
with Clock_Timers.Digital_Clocks; use Clock_Timers.Digital_Clocks;
with Ada.Text_IO; use Ada.Text_IO;
procedure Test_Observers is
Timer : aliased Clock_Timer;
Clock : Digital_Clock (Timer'Access);
begin
delay 3.0;
New_Line;
declare
Another_Clock : Digital_Clock (Timer'Access);
begin
delay 5.0;
New_Line;
declare
Yet_Another_Clock : Digital_Clock (Timer'Access);
begin
delay 4.0;
New_Line;
end;
delay 3.0;
New_Line;
end;
end Test_Observers;
|
