Timing Example was Re: Interrupt handler and Ada.Real_Time.Timing_Events

[anon@anon.org (anon)]

This is a Timeing example that uses "Ada.Real_Time.Timing_Events" package.

Now, adding an interrupt handler to this design you should wrap the interrupt 
handler within a Task routine bacuse "Ada.Real_Time.Timing_Events" uses 
tasking for its underlying algorithm, then call the Timers Shutdown routine 
once the interrupt has occurred.

--
-- generic_timers.ads
--
with Ada.Real_Time.Timing_Events ;

generic
  Multi_Events : Boolean := True ;
  Timer_Name   : String := "Generic_Timers" ;
  Interval     : in Ada.Real_Time.Time_Span ;
  with procedure Action is <> ;

package Generic_Timers is

  Timer_Error : exception ;

  procedure Activate ;
  procedure Shutdown ;

private

  The_Event : Ada.Real_Time.Timing_Events.Timing_Event ;

end Generic_Timers ;

--
-- generic_timers.adb
--
with Ada.Real_Time ;
use  Ada.Real_Time ;

package body Generic_Timers is


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

  protected body Events is
    procedure Handler ( Event: in out Timing_Events.Timing_Event ) is
      begin
        Action ;
        if Multi_Events then
          Activate ;  -- periodic timer continues
        end if ;
      end Handler ;
  end Events ;

  procedure Activate is
    use type Timing_Events.Timing_Event_Handler ;
  begin
    if Timing_Events.Current_Handler ( The_Event ) = null then
      Timing_Events.Set_Handler ( The_Event,
                                  Interval,
                                  Events.Handler'Access ) ;
    else
      raise Timer_Error with "Activation " & Timer_Name ;
    end if ;
   end Activate ;

  procedure Shutdown is
      Success : Boolean := False ;
      use type Timing_Events.Timing_Event_Handler ;
    begin
      if Timing_Events.Current_Handler ( The_Event ) /= null then
         Timing_Events.Cancel_Handler ( The_Event, Success ) ;
         if not Success then
            raise Timer_Error with "Shutdown: " & Timer_Name ;
         end if ;
      end if ;
    end Shutdown ;

end Generic_Timers ;

--
-- timers.ads
--
package Timers is

   procedure Activate ;
   procedure Shutdown ;

end Timers ;

--
-- Timers.adb
--
with Ada.Real_Time ;
with Ada.Text_IO ;

with Generic_Timers ;

package body Timers is

   use Ada ;
   use Real_Time ;
   use Text_IO ;

   ------------------------------------
   --  Define Periodic Event Timers  --
   ------------------------------------
   Periodic_Interval : constant Time_Span := Milliseconds ( 2000 ) ;
   Periodic_Timer_ID : constant String := "Periodic Timer" ;

   procedure Periodic_Action is
   begin
      Put_Line ( "Timeout: Periodic Timer" ) ;
   end Periodic_Action ;

   Package Periodic_Timer is new Generic_Timers ( True,
                                                  Periodic_Timer_ID, 
                                                  Periodic_Interval, 
                                                  Periodic_Action ) ;

   ----------------------------------
   --  Define Single Event Timers  --
   ----------------------------------
   Single_Interval : constant Time_Span := Milliseconds ( 1000 ) ;
   Single_Timer_ID : constant String := "Single Timer" ;

   procedure Single_Action is
   begin
      Put_Line ( "Timeout: Single Timer " ) ;
   end Single_Action ;

   Package Single_Timer is new Generic_Timers ( False,
                                                Single_Timer_ID,
                                                Single_Interval,
                                                Single_Action ) ;

  ----------------------------
  --  Controlling Routines  --
  ----------------------------

  procedure Activate is
   begin
      Put_Line ( "Timers: Activate" ) ;

      Periodic_Timer.Activate ;

      for Index in 0 .. 3 loop
        Single_Timer.Activate ;
        delay 7.0 ;
      end loop;
    end Activate ;

  procedure Shutdown is
    begin
      Put_Line ( "Timers: Shutdown" ) ;
      Periodic_Timer.Shutdown ;
      Single_Timer.Shutdown ;
    end Shutdown;

end Timers ;

--
-- testing.adb
--
with Ada.Exceptions ;
with Ada.Text_IO ;

with Timers ;

procedure Testing is

   use Ada ;
   use Text_IO ;

begin

   Put_Line ( "Testing : Begin" ) ;

   Timers.Activate ;
   delay 5.0 ;
   Timers.Shutdown ;
   
   Put_Line ( "Testing : End" ) ;
exception
   when Error : others =>
       Put_Line ( "Testing fails for because of ==> "
                  & Exceptions.Exception_Information ( Error ) ) ;
end Testing ;



In <guk532$u44$1@news.motzarella.org>, Reto Buerki <reet@codelabs.ch> writes:
>Hi,
>
>I hit a rather strange issue today mixing signal/interrupt handling with
>Ada.Real_Time.Timing_Events. We have a real life application where we
>use timing events but we also need a signal handler to catch signals
>from the environment (SIGTERM etc.).
>
>I wrote a small reproducer to illustrate the problem. The following
>protected object is used as an interrupt handler, which can be attached
>to a specific interrupt/signal:
>
>with Ada.Interrupts;
>
>package Handlers is
>
>   protected type Signal_Handler (Signal : Ada.Interrupts.Interrupt_ID)
>   is
>      pragma Interrupt_Priority;
>
>      entry Wait;
>   private
>      procedure Handle_Signal;
>      pragma Attach_Handler (Handle_Signal, Signal);
>
>      Occured : Boolean := False;
>   end Signal_Handler;
>
>end Handlers;
>
>package body Handlers is
>
>   protected body Signal_Handler is
>      procedure Handle_Signal is
>      begin
>         Occured := True;
>      end Handle_Signal;
>
>      entry Wait when Occured is
>      begin
>         if Wait'Count = 0 then
>            Occured := False;
>         end if;
>      end Wait;
>   end Signal_Handler;
>
>end Handlers;
>
>The handler is used like this:
>
>with Ada.Text_IO;
>with Ada.Interrupts.Names;
>
>--  Uncommenting the next line breaks interrupt handler
>--  with Ada.Real_Time.Timing_Events;
>
>with Handlers;
>
>procedure Interrupt_Problem is
>   use Ada.Interrupts;
>
>   Handler : Handlers.Signal_Handler (Signal => Names.SIGTERM);
>begin
>
>   if Is_Attached (Interrupt => Names.SIGTERM) then
>      Ada.Text_IO.Put_Line ("Attached handler to SIGTERM");
>   else
>      Ada.Text_IO.Put_Line ("Could not attach to SIGTERM!");
>      return;
>   end if;
>
>   Handler.Wait;
>   Ada.Text_IO.Put_Line ("Interrupt received ...");
>
>end Interrupt_Problem;
>
>As expected, when sending SIGTERM to the running 'Interrupt_Problem'
>process "Interrupt received ..." is displayed. So far so good.
>
>As commented in the source code, as soon as the
>Ada.Real_Time.Timing_Events package is with'ed, this mechanism breaks.
>
>The signal handler is not invoked any more when I send a SIGTERM signal
>to a running 'Interrupt_Problem' process, it just terminates without
>triggering the Handler.Wait.
>
>What could be the cause for this behavior? Is there a problem with this
>code?
>
>Thanks in advance!
>- reto