An Example for Ada.Execution_Time

[anon@att.net]

You ask for an example.

Here is an example for packages (Tested using MaRTE):
  Ada.Execution_Time         -- Defines Time type and main operations as
                             -- well as the primary Clock for this type

  Ada.Execution_Time.Timers  -- Links to Timers 


Altering this example one could use a number of timers to be set 
using different times. Or testing a number of algorithms using 
the timer.

Also, I do have a Real_Time non-Task version that this example was 
based on.


-------------------------------
-- Work.adb -- Main program

with Ada.Integer_Text_IO ;
with Ada.Text_IO ;
with Work_Algorithm ;         -- Contains worker algorithm
with Work_Execution_Time ;    -- Contains execution Timing routines

procedure Work is

  use Ada.Integer_Text_IO ;
  use Ada.Text_IO ;
  use Work_Execution_Time ; 

  Task_0 : Work_Task ;

begin -- Work
  Initialize ( Work_Algorithm'Access ) ;
  Task_0.Start ( False ) ;

  -- Prints results of Test

  New_Line ;
  Put ( "Event occured " ) ;
  Put ( Item => Counter, Width => 3 ) ;
  Put_Line ( " Times." ) ;
  New_Line ;

end Work ;

-------------------------------
-- Work_Algorithm.ads

procedure Work_Algorithm ;

-------------------------------
-- Work_Algorithm.adb

with Ada.Integer_Text_IO ;
with Ada.Text_IO ;

procedure Work_Algorithm is
    use Ada.Integer_Text_IO ;
    use Ada.Text_IO ;
  begin
    for Index in 0 .. 15 loop
      Put ( "Paused =>" ) ;
      Put ( Index ) ;
      New_Line ;
      delay 1.0 ;
    end loop ;
  end Work_Algorithm ;


-------------------------------
-- Work.Execution_Time.ads

with Ada.Execution_Time ;
with Ada.Real_Time ;

package Work_Execution_Time is

  type Algorithm_Type is access procedure ;

  task type Work_Task is
    entry Start ( Active : in Boolean ) ;
  end Work_Task ;


  Counter    : Natural ;

  procedure Initialize ( A : in Algorithm_Type ) ;

private 

  Algorithm  : Algorithm_Type ;

  Start_Time : Ada.Execution_Time.CPU_Time ;
  At_Time    : Ada.Execution_Time.CPU_Time ;
  In_Time    : Ada.Real_Time.Time_Span ;

end Work_Execution_Time ;

-------------------------------
-- Work_Execution_Time ;
with Ada.Integer_Text_IO ;
with Ada.Text_IO ;
with Ada.Execution_Time ;
with Ada.Execution_Time.Timers ;
with Ada.Real_Time ;
with Ada.Task_Identification ;

package body Work_Execution_Time is


    use Ada.Execution_Time ;
    use Ada.Real_Time ;
    use Timers ;

    package D_IO is new Ada.Text_IO.Fixed_IO ( Duration ) ;
    package S_IO is new Ada.Text_IO.Integer_IO
                                      ( Ada.Real_Time.Seconds_Count ) ;

  protected Handlers is
    -- Handler: Single Event
      procedure Handler_1 ( TM : in out Timer ) ;

    -- Handler: Multple Event
      procedure Handler_2 ( TM : in out Timer ) ;
  end Handlers ;



  task body Work_Task is

      use Ada.Task_Identification ;

    ID         : aliased Task_Id := Current_Task ;
    TM         : Timers.Timer ( ID'Access ) ;

    Cancelled  : Boolean := False ;

  begin
    Counter := 0 ;
    loop
      select
        Accept Start ( Active : in Boolean ) do
          if Active then
            Start_Time := Ada.Execution_Time.Clock ;
            At_Time := Start_Time + Milliseconds ( 5 ) ;
            Set_Handler ( TM, AT_Time, Handlers.Handler_2'Access ) ;
          else
            Start_Time := Ada.Execution_Time.Clock ;
            In_Time := Milliseconds ( 10 ) ;
            Set_Handler ( TM, In_Time, Handlers.Handler_2'Access ) ;
          end if ;

          Algorithm.all ;  -- Execute Test algorithm

          Timers.Cancel_Handler ( TM, Cancelled ) ;
        end Start ;
      or
        terminate ;
      end select ;
    end loop ;
  end Work_Task ;


  --
  -- Timer Event Routines
  --
  protected body Handlers is 

    -- Handler: Single Event

    procedure Handler_1 ( TM : in out Timer ) is

        Value     : Time_Span ;
        Cancelled : Boolean ;

      begin
        Value := Time_Remaining ( TM ) ;
        Ada.Text_IO.Put ( "Timing Event Occured at " ) ;
        D_IO.Put ( To_Duration ( Value ) ) ;
        Ada.Text_IO.New_Line ;
        Counter := Counter + 1 ;
        Cancel_Handler ( TM, Cancelled ) ;
      end Handler_1 ;

    -- Handler: Multple Event

    procedure Handler_2 ( TM : in out Timer ) is

        Value   : Time_Span ;

      begin
        Value := Time_Remaining ( TM ) ;
        Ada.Text_IO.Put ( "Timing Event Occured at " ) ;
        D_IO.Put ( To_Duration ( Value ) ) ;
        Ada.Text_IO.New_Line ;
        Counter := Counter + 1 ;

        Start_Time := Ada.Execution_Time.Clock ;
        In_Time := Ada.Real_Time.Milliseconds ( 10 ) ;
        Set_Handler ( TM, In_Time, Handlers.Handler_2'Access ) ;
      end Handler_2 ;

  end Handlers ;


  -- Initialize: Set Algorithm and Counter

  procedure Initialize ( A : in Algorithm_Type ) is
    begin
      Algorithm := A ;
      Counter := 0 ;
    end Initialize ;

end Work_Execution_Time ;