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.3 required=5.0 tests=BAYES_00, REPLYTO_WITHOUT_TO_CC autolearn=no autolearn_force=no version=3.4.4 X-Google-Thread: a07f3367d7,e69505d5161d7d41 X-Google-Attributes: gida07f3367d7,public,usenet X-Google-NewGroupId: yes X-Google-Language: ENGLISH,ASCII-7-bit Path: g2news2.google.com!news2.google.com!news.glorb.com!wn14feed!worldnet.att.net!bgtnsc05-news.ops.worldnet.att.net.POSTED!53ab2750!not-for-mail Newsgroups: comp.lang.ada From: anon@anon.org (anon) Subject: Timing Example was Re: Interrupt handler and Ada.Real_Time.Timing_Events Reply-To: anon@anon.org (anon) References: X-Newsreader: IBM NewsReader/2 2.0 Message-ID: Date: Sat, 16 May 2009 11:05:11 GMT NNTP-Posting-Host: 12.65.30.170 X-Complaints-To: abuse@worldnet.att.net X-Trace: bgtnsc05-news.ops.worldnet.att.net 1242471911 12.65.30.170 (Sat, 16 May 2009 11:05:11 GMT) NNTP-Posting-Date: Sat, 16 May 2009 11:05:11 GMT Organization: AT&T Worldnet Xref: g2news2.google.com comp.lang.ada:5870 Date: 2009-05-16T11:05:11+00:00 List-Id: 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 , Reto Buerki 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