From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-0.9 required=5.0 tests=BAYES_00,FORGED_GMAIL_RCVD,
	FREEMAIL_FROM autolearn=no autolearn_force=no version=3.4.4
X-Google-Thread: 103376,5b15c37c5d0c986f,start
X-Google-Attributes: gid103376,public
X-Google-Language: ENGLISH,ASCII-7-bit
Path: 
 g2news1.google.com!postnews.google.com!v46g2000cwv.googlegroups.com!not-for-mail
From: "Anh Vo" <anhvofrcaus@gmail.com>
Newsgroups: comp.lang.ada
Subject: Designing Timers using Ada.Real_Time.Timing_Events package
Date: 25 Mar 2006 12:03:30 -0800
Organization: http://groups.google.com
Message-ID: <1143317010.868435.251190@v46g2000cwv.googlegroups.com>
NNTP-Posting-Host: 71.146.81.142
Mime-Version: 1.0
Content-Type: text/plain; charset="iso-8859-1"
X-Trace: posting.google.com 1143317016 31391 127.0.0.1 (25 Mar 2006 20:03:36
 GMT)
X-Complaints-To: groups-abuse@google.com
NNTP-Posting-Date: Sat, 25 Mar 2006 20:03:36 +0000 (UTC)
User-Agent: G2/0.2
X-HTTP-UserAgent: Mozilla/5.0 (X11; U; Linux i686; en-US;
 rv:1.0.1) Gecko/20020830,gzip(gfe),gzip(gfe)
Complaints-To: groups-abuse@google.com
Injection-Info: v46g2000cwv.googlegroups.com; posting-host=71.146.81.142;
   posting-account=JVr7Xg0AAAAI3MbuARxMmvWLmA7qdJMx
Xref: g2news1.google.com comp.lang.ada:3606
Date: 2006-03-25T12:03:30-08:00
List-Id: <comp.lang.ada>

All,

I attempted to design a basic timer package using the capabilities
provided by low level package Timing_Events as shown.

with Ada.Real_Time.Timing_Events;
package Basic_Timers is

   use Ada;

   Basic_Timer_Error : exception;

   type Timer_Type is abstract tagged limited private;
   type Timer_Type_Class is access all Timer_Type'Class;

   procedure Update (Observer : access Timer_Type) is abstract;

   procedure Set (This : access Timer_Type'Class;
                         Period : in Real_Time.Time_Span);
   procedure Start (This : access Timer_Type'Class);
   procedure Stop (This : access Timer_Type'Class);
   procedure Cancel (This : access Timer_Type'Class) renames Stop;

private

   protected type Events is
      procedure Handler (Event: in out
Real_Time.Timing_Events.Timing_Event);
   end Events;

   type Timer_Type is abstract tagged limited
      record
         Period : Real_Time.Time_Span;
         Started : Boolean := False;
         Event : Real_Time.Timing_Events.Timing_Event;
         The_Handler : Events;
      end record;

   The_Timer : Timer_Type_Class := null;

end Basic_Timers;

package body Basic_Timers is

   protected body Events is
      procedure Handler (Event: in out
Real_Time.Timing_Events.Timing_Event) is
      begin
         The_Timer.Started := False;
         Update (The_Timer);
      end Handler;
   end Events;

   procedure Set (This : access Timer_Type'Class;
                        Period : in Real_Time.Time_Span) is
   begin
      This.Period := Period;
      The_Timer := Timer_Type_Class (This);
   end Set;

   procedure Start (This : access Timer_Type'Class) is
   begin
       if not This.Started then
          This.Started := True;
          Real_Time.Timing_Events.Set_Handler (
                      This.Event, This.Period,
This.The_Handler.Handler'access);
       else
          raise Basic_Timer_Error with "Wrong usage, basic timer
already started";
       end if;
   end Start;

   procedure Stop (This : access Timer_Type'Class) is
      Success : Boolean := False;
      use type Ada.Real_Time.Timing_Events.Timing_Event_Handler;
   begin
      if Real_Time.Timing_Events.Current_Handler (This.Event) /= null
then
         Real_Time.Timing_Events.Cancel_Handler (This.Event, Success);
         if Success then
            This.Started := False;
         else
            raise Basic_Timer_Error with "fail to cancel the basic
timer";
         end if;
      end if;
   end Stop;

end Basic_Timers;

It works fine as shown in the test codes

with Basic_Timers;
package Timers_Test1 is

   type State_Transition_Timer_Type is new
                                   Basic_Timers.Timer_Type with null
record;
   procedure Update (Observer : access State_Transition_Timer_Type);

   procedure Start;
   procedure Shutdown;

end Timers_Test1;

with Ada.Real_Time;
with Ada.Text_Io;
package body Timers_Test1 is

   use Ada;
   use Text_Io;

   State_Transition_Time : constant Real_Time.Time_Span :=
                                                 Real_Time.Milliseconds
(3000);
   State_Transition_Timer : aliased State_Transition_Timer_Type;

   procedure Update (Observer : access State_Transition_Timer_Type) is
   begin
      Put_Line ("The state Timer just expires. Do some thing here");
   end Update;

   procedure Start is
   begin
      Basic_Timers.Set (State_Transition_Timer'access,
State_Transition_Time);
      for Index in 1 .. 5 loop
         Basic_Timers.Start (State_Transition_Timer'access);
         delay 4.0;
      end loop;
   end Start;

   procedure Shutdown is
   begin
      Basic_Timers.Cancel (State_Transition_Timer'access);
   end Shutdown;

end Timers_Test1;

Howver, it ran into deadlock when the Update attempts to Start the
timer again as part of periodic timer as shown below.

with Basic_Timers;
package Timers_Test2 is

   type Periodic_Timer_Type is new
                                   Basic_Timers.Timer_Type with null
record;
   procedure Update (Observer : access Periodic_Timer_Type);

   procedure Start;
   procedure Shutdown;

end Timers_Test2;

with Ada.Real_Time;
with Ada.Text_Io;
package body Timers_Test2 is

   use Ada;
   use Text_Io;

   Periodic_Time : constant Real_Time.Time_Span :=
                                                 Real_Time.Milliseconds
(3000);
   Periodic_Timer : aliased Periodic_Timer_Type;

   procedure Update (Observer : access Periodic_Timer_Type) is
   begin
       Put_Line ("The state Timer just expires. Do some thing here");
       Basic_Timer.Start (Periodic_Timer);  --!!! causing deadlock
   end Update;

   procedure Start is
   begin
       Basic_Timers.Set (Periodic_Timer'access, Periodic_Time);
       Basic_Timers.Start (Periodic_Timer'access);
   end Start;

   procedure Shutdown is
   begin
       Basic_Timers.Cancel (Periodic_Timer'access);
   end Shutdown;

end Timers_Test2;

Just like semaphore if it is not used correctly, deadlock can occur as
in this case. Instead of limiting its usage, my desire to come with a
safer timer. This time I use a task to uncouple the protected handler
and the call back. I put it in a package called Sate_Timers. Its spec.
is the same as Basic_Timers spec. Thus, only its body is shown here to
cut down the lenghth of this message.

with System;
package body Safe_Timers is

   task Event_Handoff is
      pragma Priority (System.Priority'last - 2); -- Make sure it is
done
      entry Handoff;                                     -- without
interruption
   end Event_Handoff;

   task body Event_Handoff is
   begin
      Longlive :
      loop
         select
            accept Handoff;
            The_Timer.Started := False;
            Update (The_Timer);  -- dispatching to the observer
(callback)
         or
            terminate;  -- later alligator
         end select;
      end loop Longlive;
   end Event_Handoff;

   protected body Events is
      procedure Handler (Event: in out
Real_Time.Timing_Events.Timing_Event) is
      begin
         pragma Warnings (Off);
         Event_Handoff.Handoff;
      end Handler;
   end Events;

   procedure Set (This : access Timer_Type'Class;
                         Period : in Real_Time.Time_Span) is
   begin
      This.Period := Period;
      The_Timer := Timer_Type_Class (This);
   end Set;

   procedure Start (This : access Timer_Type'Class) is
   begin
      if not This.Started then
         This.Started := True;
         Real_Time.Timing_Events.Set_Handler (
                     This.Event, This.Period,
This.The_Handler.Handler'access);
      else
         raise Safe_Timer_Error with "Wrong usage - timer already
started";
      end if;
   end Start;

   procedure Stop (This : access Timer_Type'Class) is
      Success : Boolean := False;
      use type Ada.Real_Time.Timing_Events.Timing_Event_Handler;
   begin
      if Real_Time.Timing_Events.Current_Handler (This.Event) /= null
then
         Real_Time.Timing_Events.Cancel_Handler (This.Event, Success);
         if Success then
            This.Started := False;
         else
            raise Safe_Timer_Error with "fail to cancel the timer";
         end if;
      end if;
   end Stop;

end Safe_Timers;

Now Timers_Test2 does not cause deadlock any more.

I would like to know if I used Timing_Events package correctly in term
of its purpose. Secondly, is there any thing that these timers packages
can be improved. Thank you in advance for your thoughts.

AV
PS : these codes compiled and run on gnatgcc-4.2.0