Re: "Classes" as packages in Ada

[eachus@spectre.mitre.org (Robert I. Eachus)]

In article <EACHUS.98Nov25182652@spectre.mitre.org> eachus@spectre.mitre.org (Robert I. Eachus) writes:


   It's not usual to respond to your own message, but there are some
race conditions in the body of the generic I posted.   I realized that
they existed as I was driving home.  (And that is one of the very nice
things about Ada tasking--it makes these things pretty obvious.)

   The first is easy to fix, and in this case it is really a fix.  If
a call to Set occurs during notification, some waiters will get
notified of the first event and some of the second, but none will hear
of both.  The fix is to make the procedure Set an entry, and put on a
guard:

       protected type Observed_Object is
--	 procedure Set(Observed: in Object);
         entry Set(Observed: in Object);
	 function Value return Object;
	 entry Modified(Observed: out Object);
       private
	 entry Waiting(Observed: out Object);
	 Current: Object;
	 Reporting: Boolean := False;
       end Observed_Object;

       protected body Observed_Object is
         entry Set (Observed: in Object) when not Reporting is
--	 procedure Set (Observed: in Object) is
	 begin
	   Current := Observed;
	   Reporting := True;
	 end Set;

	 function Value return Object is begin return Current; end Value;

	 entry Modiified(Observed: out Object) when not Reporting is  
	 begin requeue Waiting; end;

	 entry Waiting(Observed: out Object) when Reporting is
	 begin
	   Observed := Current;
	   if Waiting'Count = 0 then Reporting := False; end if;
	 end; 

       end Observed_Object;

    The second potential problem is that an event may occur while one
of the consumers is still processing the previous event.  The best way
to deal with this is to put a counter in the events, and to keep a
buffer of previous events to be dealt with.  Of course, the reality is
that some consumers may really need all events, and others may only
need to see the most recent event.  (I'm used to situations where
updates are periodic and only the most recent event should be
handled.)  So I choose the KISS principle and leave it to the consumer
of the events to choose which type of processing is required.

    However, that doesn't deal with all possibilities.  A consumer may
process all known events then queue up, but just miss the next event
in a race.  So let's internalize the counter to simplify things:


       protected type Observed_Object is
         entry Set(Observed: in Object);
	 function Value return Object;
	 entry Modified(Observed: out Object; Last: in out Integer);
       private
	 entry Waiting(Observed: out Object; Last: in out Integer);
	 Current: Object;
         Count: Integer := 0;
	 Reporting: Boolean := False;
       end Observed_Object;

       protected body Observed_Object is
         entry Set (Observed: in Object) when not Reporting is
	 begin
	   Current := Observed;
           if Count = Integer'Last
           then Count := 0;
           else Count := Count + 1;
           end if;  -- at 32 bits and 100 events per second rolls over
                    -- after eight months.
	   Reporting := True;
	 end Set;

	 function Value return Object is begin return Current; end Value;

         function Current_Count return Integer is 
         begin
           return Count;
         end Current_Count;

	 entry Modified(Observed: out Object; Last: in out Integer)
            when not Reporting is  
	 begin
           if Last /= Count
           then
             Observed := Current;
             Last := Count;
           else 
             requeue Waiting;
           end if;
         end Modified;

	 entry Waiting(Observed: out Object; Last: in out Integer)
           when Reporting is
	 begin
	   Observed := Current;
           Last := Count;
	   if Waiting'Count = 0 then Reporting := False; end if;
	 end; 

       end Observed_Object;

       If you prefer, the counter can be made part of the obesrved
object, but then you really need to pass the old count value as a
separate parameter, so the interface isn't that much cleaner.
--

					Robert I. Eachus

with Standard_Disclaimer;
use  Standard_Disclaimer;
function Message (Text: in Clever_Ideas) return Better_Ideas is...