AdaPower Logged in as Guest
Ada Tools and Resources

Ada 95 Reference Manual
Ada Source Code Treasury
Bindings and Packages
Ada FAQ


Join >
Home >
Articles >
Getting Started >
Ada FAQ >
Source Treasury >
Books & Tutorials >
Packages for Reuse >
Latest Additions >
Ada Projects >
Press Releases >
Ada Audio / Video >
Home Pages >
Links >
Contact >
About >
Login >
Back
Observing a Concurrent Subject (Matthew Heaney)

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;


(c) 1998-2004 All Rights Reserved David Botton