From: "Anh Vo" <anhvofrcaus@gmail.com>
Subject: Designing Timers using Ada.Real_Time.Timing_Events package
Date: 25 Mar 2006 12:03:30 -0800
Date: 2006-03-25T12:03:30-08:00 [thread overview]
Message-ID: <1143317010.868435.251190@v46g2000cwv.googlegroups.com> (raw)
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
next reply other threads:[~2006-03-25 20:03 UTC|newest]
Thread overview: 17+ messages / expand[flat|nested] mbox.gz Atom feed top
2006-03-25 20:03 Anh Vo [this message]
2006-03-25 20:58 ` Designing Timers using Ada.Real_Time.Timing_Events package Dmitry A. Kazakov
2006-03-26 5:39 ` Anh Vo
2006-03-26 12:58 ` Dmitry A. Kazakov
2006-03-26 16:18 ` Anh Vo
2006-03-26 18:22 ` Dmitry A. Kazakov
2006-03-26 19:43 ` Anh Vo
[not found] ` <3itd22hcekts5lsojdqjnn966bbvc8fckh@4ax.com>
2006-03-26 23:53 ` Anh Vo
[not found] ` <0mae22lshe5nee8pt8h7seussloebv07g3@4ax.com>
2006-03-27 5:01 ` Anh Vo
[not found] ` <5vse22h4mc1och27s0nkbv986csi2rorki@4ax.com>
2006-03-28 0:07 ` Anh Vo
2006-03-27 7:49 ` Dmitry A. Kazakov
2006-03-27 18:14 ` Dmitry A. Kazakov
2006-03-27 22:00 ` Anh Vo
2006-03-28 7:51 ` Dmitry A. Kazakov
2006-03-28 16:00 ` Anh Vo
2006-03-26 7:59 ` Martin Krischik
2006-03-26 15:50 ` Anh Vo
replies disabled
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox