Version 1.7 of ais/ai-00297.txt

Unformatted version of ais/ai-00297.txt version 1.7
Other versions for file ais/ai-00297.txt

!standard D.8 (00)          03-03-11 AI95-00297/05
!class amendment 02-06-01
!status work item 02-06-01
!status received 02-06-01
!priority High
!difficulty Medium
!subject Timing Events
!summary
A mechanism is proposed to allow user-defined procedures to be executed at a specified time without the need to use a task or a delay statement.
!problem
An exploration of various flexible scheduling schemes, for example imprecise computation, has illustrated the need a) to asynchronously change the priority of a task at a particular future time, and b) to allow tasks to come off the delay queue at a different priority to that in effect when the task was delayed. This functionality can only be achieved by the use of a 'minder' high priority task that makes the necessary priority changes to its client. This is an inefficient and inelegant solution.
More generally, Ada provides only one mechanism for associating the execution of code with points in time. A lower level primitive would increase the applicability of the Ada language. A protected procedure can currently be associated with interrupt events; the proposal allows similar functionality for timing events.
!proposal
A child package of Ada.Real_Time is proposed.
package Ada.Real_Time.Timing_Events is
type Timing_Event is limited private;
type Timing_Event_Handler is access protected procedure(TE : in out Timing_Event);
procedure Set_Handler(TE : in out Timing_Event; At_Time : in Time; Handler: in Timing_Event_Handler);
procedure Set_Handler(TE : in out Timing_Event; In_Time: in Time_Span; Handler: in Timing_Event_Handler);
function Is_Handler_Set(TE : Timing_Event) return boolean;
function Current_Handler(TE : Timing_Event) return Timing_Event_Handler;
procedure Cancel_Handler(TE : in out Timing_Event; Cancelled : out Boolean);
function Time_Of_Event(TE : Timing_Event) return Time;
private ... -- not specified by the language end Ada.Real_Time.Timing_Events;
A call to a Set_Handler procedure returns when the Handler is registered.
At a time no earlier than that implied by the time parameter, the handler procedure is executed. The detailed rules governing timing accuracy are the same as D.9. The assumption is that the procedure may be executed by the real-time clock interrupt mechanism. Hence the ceiling priority of the protected procedure (Timing_Event_Handler) must be interrupt_priority'last. It is a bounded error to use a protected procedure with a priority less than interrupt_priority'last.
If a Set_Handler procedure is called with zero or negative In_Time or with At_time indicating a time in the past then the Handler is executed immediately by the task executing the Set_Handler call. The rationale for this follows from a comparison with delay and delay until that act as null operations in these circumstances. An exception raised during the execution of a Handler is ignored (c.f. interrupts - C.3(7)).
A call of either Set_Handler procedure is not a potentially suspending operation and hence can be called from within a Handler (e.g. a Handler can set up a future timing event).
A call to a Set_Handler procedure for a timing event that is already set will override the first set operation (i.e. equivalent to making a call to Cancel_Handle first).
A call to Is_Handler_Set following a call to Cancel_Handler for the same timing_event will return false. A call to Cancel_Handler returns with Cancelled set to True if the event was set prior to it been cancelled; otherwise the parameter is set to False and the call has no effect. A call to Current_Handler for a timing event that is not set will return null. A call to Time_Of_Event for a timing event that is not set will return Time_First.
A number of timing events registered for the same time will execute in FIFO order. Note, all will be executed before any other application code.
!wording
Add new section D.15
D.15 Timing Events
This clause introduces a language-defined child package of Ada.Real_Time to allow user-defined protected procedures to be executed at a specified time without the need to use a task or a delay statement.
Static Semantics
The following language-defined package exists:
package Ada.Real_Time.Timing_Events is type Timing_Event is limited private; type Timing_Event_Handler is access protected procedure(Event : in out Timing_Event); procedure Set_Handler(Event : in out Timing_Event; At_Time : in Time; Handler: in Timing_Event_Handler); procedure Set_Handler(Event : in out Timing_Event; In_Time: in Time_Span; Handler: in Timing_Event_Handler); function Is_Handler_Set(Event : Timing_Event) return Boolean; function Current_Handler(Event : Timing_Event) return Timing_Event_Handler; procedure Cancel_Handler(Event : in out Timing_Event; Cancelled : out Boolean); function Time_Of_Event(Event : Timing_Event) return Time; private ... -- not specified by the language end Ada.Real_Time.Timing_Events;
An object of type Timing_Event is said to be set if it has a registered Timing_Event_Handler. An object is said to be cleared if it has no registered Timing_Event_Handler. All Timing_Event objects are initially cleared.
A call to a Set_Handler procedure returns after the Timing_Event denoted by Event is set.
Dynamic Semantics
A call of either Set_Handler procedure is not a potentially suspending operation and hence can be called from within an object of type Timing_Event_Handler.
Following a call of a Set_Handler procedure, at a time no earlier than that specified by the time parameter, the Timing_Event_Handler procedure is executed. The rules governing timing accuracy are the same as in D.9. The Timing_Event_Handler is only executed if the timing event is set at the time of execution. Following the execution of the Timing_Event_Handler the Timing_Event denoted by Event is cleared.
When a Set_Handler procedure is called, a check is made that the ceiling priority of Timing_Event_Handler is Interrupt_Priority'last. If the check fails, Program_Error is raised.
If a Set_Handler procedure is called with zero or negative In_Time or with At_Time indicating a time in the past then Timing_Event_Handler is executed immediately by the task executing the Set_Handler call. The Timing_Event denoted by Event is cleared.
An exception propagated from a Timing_Event_Handler invoked by a timing event has no effect.
A call to a Set_Handler procedure for a Timing_Event that is already set will initially cancel the earlier registration. The Timing_Event denoted by Event remains set.
A call to Is_Handler_Set returns True if Event is set; otherwise it returns False.
A call to Cancel_Handler returns after the Timing_Event denoted by Event is cleared. Cancelled is assigned True if Event was set prior to it being cleared; otherwise the parameter is assigned False.
A call to Current_Handler returns with the current Timing_Event_Handler. If the Timing_Event denoted Event is not set, Current_Handler returns null.
A call to Time_Of_Event returns with the time of Event. If Event is not set, Time_Of_Event returns Ada.Real_Time.Time_First.
As the final step of finalization of an object of type Timing_Event, the Timing_Event is cleared.
If several timing events are registered for the same time, they are executed in FIFO order.
Implementation Advice
The protected handler procedure should be executed directly by the real-time clock interrupt mechanism.
Add to D.7 a new restriction identifier
No_Local_Timing_Events
Timing_Events shall be declared only at library level.
Add this restriction to the Ravenscar definition (D.13).
!discussion
The proposal provides an effective solution for some specific scheduling algorithms. Moreover it provides an additional paradigm for programming real-time systems. The use of timing events may reduce the number of tasks in a program and hence reduce the overheads with context switching. All tasks will suffer interference from timing events, hence they give rise to priority inversion. They are thus not an alternative to the use of time-triggered tasks, but provide an efficient means of programming short time-triggered procedures. Note, with all current implementation a low priority task coming off a delay queue will cause priority inversion.
The type, timing_event, provides an easy means for cancelling an event. It also allows an implementation to allocate an object that will be linked into the delay queue. An implementation that links task control blocks (TCB) within its delay queue will, in effect, define a pseudo TCB for each declared timing event.
!example
The attached appendix has an extended example but uses an earlier definition of the feature. Two further illustrations are given here. First, a watchdog timer. Here a condition is tested every 50 milliseconds. If the condition has not been called during this time an alarm handling task is released.
with Ada.Real_Time; use Ada.Real_Time; with Ada.Real_Time.Timing_Events; use Ada.Real_Time.Timing_Events; with System; use System; ...
protected Watchdog is pragma Interrupt_Priority (Interrupt_Priority'Last); entry Alarm_Control; -- called by alarm handling task procedure Timer(TE : in out Timing_Event); -- timer event code procedure Call_in; -- called by application code every 50ms if alive private Alarm : Boolean := False; end Watchdog;
Fifty_Mil_Event : Timing_Event; TS : Time_Span := Milliseconds(50);
protected body Watchdog is entry Alarm_Control when Alarm is begin Alarm := False; end Alarm_Control;
procedure Timer(TE : in out Timing_Event) is begin Alarm := True; end Timer;
procedure Call_in is begin Set_Handler(Fifty_Mil_Event, TS, Watchdog.Timer'access); -- note, this call to Set_Handler cancels the previous call end Call_in; end Watchdog; ...
In situations where it is necessary to undertake a small computation periodically (and with minimum jitter) the repetitive use of timing events is an effective solution. In the following example a periodic pulse is turned on and off under control of the application:
with Ada.Real_Time; use Ada.Real_Time; with Ada.Real_Time.Timing_Events; use Ada.Real_Time.Timing_Events; with System; use System; ...
protected Pulser is pragma Interrupt_Priority (Interrupt_Priority'Last); procedure Start; procedure Stop; procedure Timer(TE : in out Timing_Event); private Next_Time : Time; end Pulser;
Pulse : Timing_Event; Pulse_Interval : Time_Span := Milliseconds(10);
protected body Pulser is procedure Start is begin Pulse_Hardware; Next_Time := Clock + Pulse_Interval; Set_Handler(Pulse, Next_Time, Pulser.Timer'access); end Start;
procedure Stop is begin Cancel_Handler(Pulse); end Stop;
procedure Timer(TE : in out Timing_Event) is begin Pulse_Hardware; Next_Time := Next_Time + Pulse_Interval; Set_Handler(TE, Next_Time, Pulser.Timer'access); end Timer; end Pulser;
!ACATS Test
ACATS test(s) need to be created.
!appendix

!standard D.8
!class amendment
!status
!priority -- we consider this to be high
!difficulty
!subject Timing Events
!from A. Burns and A.J. Wellings on behalf of IRTAW11


! summary

A mechanism is proposed to allow user-defined procedures to be executed at a
specified time without the need to use a task or a delay statement.


! problem

An exploration of various flexible scheduling scheme, for example imprecise
computation, has illustrated the need a) to asynchronously change the
priority of a task at a particular future time, and b) to allow tasks to
come off the delay queue at a different priority to that in effect when
the task was delayed. This functionality can only be achieved by the use
of a 'minder' high priority task that makes the necessary priority changes
to its client.  This is an inefficient and inelegant solution.

More generally, Ada provides only one mechanism for associating the execution
of code with points in time.  A lower level primitive would increase the
applicability of the Ada language.  A protected procedure can currently be
associated with interrupt events; the proposal allows similar functionality
for timing events.


! proposal

A child package of Ada.Real_Time is proposed.

with Ada.Real_Time; use Ada.Real_Time;
package Ada.Real_Time.Timing_Events is

  type Timing_Event is limited private;

  type Parameterless_Handler is access protected procedure;

  procedure Set_Handler(TE : in out Timing_Event; At_Time : Time;
             Handler: Parameterless_Handler);

  procedure Set_Handler(TE : in out Timing_Event; In_Time: Time_Span;
             Handler: Parameterless_Handler);

  function Is_Handler_Set(TE : Timing_Event) return boolean;

  procedure Cancel_Handler(TE : in out Timing_Event);

private
  ... -- not specified by the language
end Ada.Real_Time.Timing_Events;


A call to a Set_Handler procedure returns when the Handler is registered.

At a time no earlier than that implied by the time parameter, the handler
procedure is executed.  The detailed rules governing timing accuracy are the
same as D.9.  The assumption is that the procedure may be executed by the
real-time clock interrupt mechanism. Hence the ceiling priority of the
protected procedure (Parameterless_Handler) must be interrupt_priority'last.
It is a bounded error to use a protected procedure with a priority less than
interrupt_priority'last.

If a Set_Handler procedure is called with zero or negative In_Time or with
At_time indicating a time in the past then the Handler is executed immediately
by the task executing the Set_Handler call. The rationale for this
follows from a comparison with delay and delay until that act as
null operations in these circumstances.  An exception raised during
the execution of a Handler is ignored (c.f. interrupts - C.3(7)).

A call of either Set_Handler procedure is not a potentially suspending
operation and hence can be called from within a Handler (e.g. a
Handler can set up a future timing event).

A call to a Set_Handler procedure for a timing event that is already set will
override the first set operation (i.e. equivalent to making a call to
Cancel_Handle first).

A call to Is_Handler_Set following a call to Cancel_Handler for the
same timing_event will return false.  A call to Cancel_Handler will
have no effect if the timing event is not set.

A number of timing events registered for the same time will execute in FIFO
order. Note, all will be executed before any other application code.


! discussion

The proposal provides an effective solution for some specific scheduling
algorithms.  Moreover it provides an additional paradigm for programming
real-time systems.  The use of timing events may reduce the number of tasks
in a program and hence reduce the overheads with context switching.
All tasks will suffer interference from timing events, hence they give rise
to priority inversion.  They are thus not an alternative to the use of
time-triggered tasks, but provide an efficient means of programming short
time-triggered procedures. Note, with all current implementation a low
priority task coming off a delay queue will cause priority inversion.

The type, timing_event, provides an easy means for cancelling an event.  It also
allows an implementation to allocate an object that will be linked into the
delay queue. An implementation that links task control blocks (TCB) within
its delay queue will, in effect, define a pseudo TCB for each declared
timing event.


! examples

The attached appendix has an extended example.  Two further illustrations are
given here. First  a watchdog timer. Here a condition is tested every 50
milliseconds. If the condition has not been called during this time an
alarm handling task is released.

with Ada.Real_Time; use Ada.Real_Time;
with Ada.Real_Time.Timing_Events; use Ada.Real_Time.Timing_Events;
with System; use System;
...

protected Watchdog is
  pragma Interrupt_Priority (Interrupt_Priority'Last);
  entry Alarm_Control;    -- called by alarm handling task
  procedure Timer;        -- timer event code
  procedure Call_in;      -- called by application code every 50ms if alive
private
  Alarm : Boolean := False;
end Watchdog;

Fifty_Mil_Event : Timing_Event;
TS : Time_Span := Milliseconds(50);

protected body Watchdog is
  entry Alarm_Control when Alarm is
  begin
    Alarm := False;
  end Alarm_Control;

  procedure Timer is
  begin
    Alarm := True;
  end Timer;

  procedure Call_in is
  begin
    Set_Handler(Fifty_Mil_Event, TS, Watchdog.Timer'access);
    -- note, this call to Set_Handler cancels the previous call
  end Call_in;
end Watchdog;
...


In situations where it is necessary to undertake a small computation
periodically (and with minimum jitter) the repetitive use of timing events
is an effective solution. In the following example a periodic pulse is turned
on and off under control of the application:

with Ada.Real_Time; use Ada.Real_Time;
with Ada.Real_Time.Timing_Events; use Ada.Real_Time.Timing_Events;
with System; use System;
...

protected Pulser is
  pragma Interrupt_Priority (Interrupt_Priority'Last);
  procedure Start;
  procedure Stop;
  procedure Timer;
private
  Next_Time : Time;
end Pulser;

Pulse : Timing_Event;
Pulse_Interval : Time_Span := Milliseconds(10);

protected body Pulser is
  procedure Start is
  begin
    Pulse_Hardware;
    Next_Time := Clock + Pulse_Interval;
    Set_Handler(Pulse, Next_Time, Pulser.Timer'access);
  end Start;

  procedure Stop is
  begin
    Cancel_Handler(Pulse);
  end Stop;

  procedure Timer is
  begin
    Pulse_Hardware;
    Next_Time := Next_Time + Pulse_Interval;
    Set_Handler(Pulse, Next_Time, Pulser.Timer'access);
  end Timer;
end Pulser;


! appendix.

The following is taken from a paper by Burns and Wellings at IRTAW11.



Accessing Delay Queues

A. Burns and A.J. Wellings
Real-Time Systems Research Group Department of
Computer Science, University of York, UK

Abstract
A number of flexible scheduling schemes can be programmed in Ada 95 by
combining the more advanced features the language provides. For example,
imprecise computations would appear to be accommodated by the use of ATCs (with
timing triggers) and dynamic priorities. Unfortunately with this type of scheme,
it is difficult to ensure that the priority of the task,
following the triggering event, is at the appropriate level. This problem is
investigated and a potential solution is described. It involves opening up the
implementation of the delay queue so that application code can be executed
directly when the time is right.

1 Introduction

The dynamic priority facility of the Real-Time Systems Annex provides a
flexible means of deriving alternative scheduling algorithms (from the
predefined fixed priority preemptive approach). For example, it is relatively
easy to code an Earliest Deadline scheme with this provision [3]. In a recent
paper [1] we showed how a powerful scheduling framework can be implemented in
Ada via the use of a combination of advanced tasking features, including
dynamic priorities. Unfortunately in many of these flexible scheduling scheme
it is necessary to asynchronous change the priority of a task. This is either
to come off a delay queue at a different priority to that which was in operation
when the delay request was made or to move from a low priority to a higher one
at a specified point in time. In both of these circumstances it is impossible
for the task itself to change its own priority; it is either not runnable (i.e.
delayed) or is potentially not running (as its low priority is not high enough
- this is the reason that a priority switch is being undertaken). Hence the
flexible algorithms that have been published require a supportive (minder) task
that:

o runs at the right time,
o runs at the high priority, and
o dynamically raises the priority of its client task

Although this is adequate, in the sense of delivering the correct behaviour, it
is inefficient and inelegant. In the worst case, if all tasks wish to exhibit
flexibility, the number of tasks in the program will be doubled.
(It is possible to program a single minder task to deal with all priority
changes for all tasks, but this minder task must contain the equivalent of its
own delay queue which may be inefficient.)

The reason for Ada's difficulty with these algorithms is that only one kind of
software entity can wait on a timing event. Only the task can execute a delay.
In this paper we consider a means by which the implementation of the delay
queue can be opened up so that a protected procedure can be executed directly
when a specified time is reached. The proposal is given in section 3, following
an illustrative example in the next section. Section 4 then considers the
implications for the delay and delay until statements themselves. Ravenscar
issues are discussed briefly in section 5 and conclusions are given in section 6.

2 Imprecise Computation - An Example of the use of Dynamic Priorities

In our 1997 Workshop paper [2] we discussed the following example. One means of
increasing the utilisation and effectiveness of real-time applications is to
use the techniques that are known, collectively, as
imprecise computations [5, 4]. Tasks are structures into two phases, a mandatory
part that, as its name suggests, must be executed; and an optional part.
Various scheduling approaches are used to try and increase the likelihood that
optional parts are completed, but they do not have to
be guaranteed. With fixed priority scheduling, the mandatory phases are assigned
priorities using the deadline monotonic or rate monotonic algorithms. The
optional parts are assigned lower priorities (than any mandatory value). It is
not the concern of this paper to discuss how these priorities are obtained (or
if they are static or themselves dynamic).

The following code gives a typical periodic task with mandatory and optional
phases. It has a period of 50ms and a deadline of 40ms. In the mandatory phase,
an adequate output value (Result) is computed and
stored (externally) in a simple protected object (Store).
During the optional part, more precise values of Result are computed
and stored. The optional part is abandoned (using an ATC) when the task's
deadline arrives.

with Ada.Real_Time;
with Ada.Task_Identification;
with Ada.Dynamic_Priorities;
with System;
...

Mandatory_Pri : constant System.Priority := ...;
Optional_Pri :  constant  System.Priority := ...;
                -- less than mandatory

protected Store is
 procedure Put(X : Some_Data_Type);
 procedure Get(X : out Some_Data_Type);
private
...
end Store;

protected body Store is ...

task Example is
  pragma Priority(Mandatory_Pri);
end Example;

task body Example is
  Start_Time : Ada.Real_Time.Time := Ada.Real_Time.Clock;
  Period : Ada.Real_Time.Time_Span := Ada.Real_Time.Milliseconds(50);
  Deadline : Ada.Real_Time.Time_Span:= Ada.Real_Time.Milliseconds(40);
  Result : Some_Data_Type;
begin
  loop
    -- code of the mandatory part, including
    Result := ...
    Store.Put(Result);
    select
      delay until Start_Time + Deadline;
      Ada.Dynamic_Priorities.Set_Priority(Mandatory_Pri);
    then abort
      Ada.Dynamic_Priorities.Set_Priority(Optional_Pri);
      loop
        -- code of the optional part, including
	Result := ... Store.Put(Result);
      end loop;
    end select;
    Start_Time := Start_Time + Period;
    delay until Start_Time;
  end loop;
end Example;

Unfortunately this code is not correct. The task starts the ATC delay with a
high priority. In the abortable region the priority is lowered. When the timeout
occurs the task may not be executing and hence it may never get to raise its
priority back to the right level for its next invocation. Even if we use
finalisation in the abortable part there is no guarantee that the
finalisation code will be executed as this will also occur at the lower priority.

2.1 Possible Work-Arounds

This approach uses a shadow task that always runs at the mandatory priority.
Its sole job is to raise the priority of the `real' task when its deadline is
due. To make sure the tasks execute in a coordinated way, the start time of the
`client' task is passed to the minder task using a rendezvous. For one task to
change the priority of another requires the task ID to be known. We capture this
during the simple rendezvous.

task Minder is
  entry Register(Start : Ada.Real_Time.Time);
  pragma Priority(Mandatory_Pri);
end Minder;

task Example is
  pragma Priority(Mandatory_Pri);
end Example;

task body Example is
  Start_Time : Ada.Real_Time.Time := Ada.Real_Time.Clock;
  Period : Ada.Real_Time.Time_Span := Ada.Real_Time.Milliseconds(50);
  Deadline : Ada.Real_Time.Time_Span := Ada.Real_Time.Milliseconds(40);
  Result : Some_Data_Type;
begin
  Minder.Register(Start_Time);
  ... As Before But No Call To Increase Priority
end Example;

task body Minder is
  Start_Time : Ada.Real_Time.Time;
  Period : Ada.Real_Time.Time_Span:= Ada.Real_Time..Milliseconds(50);
  Offset : Ada.Real_Time.Time_Span:= Ada.Real_Time.Milliseconds(40);
  Id : Ada.Task_Identification.Task_Id;
begin
  accept Register(Start : Ada.Real_Time.Time) do
    Id := Register'Caller;
    Start_Time := Start;
  end Register;
  Start_Time := Start_Time + Offset;
  loop
    delay until Start_Time;
    Ada.Dynamic_Priorities.Set_Priority(Mandatory_Pri,Id);
    Start_Time := Start_Time + Period;
  end loop;
end Minder;

3 Proposed Alternative Scheme for Executing Timely Code

To remove the need for the extra minder task, we draw an analogy with Ada's
interrupt handling provisions. For non-timing events (interrupts) it is
possible to attach code (a parameterless protected procedure) to the event in
such a way that the code is executed when the event (interrupt) occurs. The
system clock reaching a specified time can also be seen as an event. Indeed
delays queues are events `waiting to happen' that are implemented by managing
interrupts from the system clock.

In this paper we shall consider `time' as defined in Annex D and hence the most
natural place to add the provision of a time-based signaling facility is a child
package of Ada.Real Time:

package Ada.Real_Time.Timing_Events is
  type Parameterless_Handler is access protected procedure;

  procedure Signal(At_Time : Time; Handler : Parameterless_Handler);
  procedure Signal(In_Time : Time_Span; Handler : Parameterless_Handler);

end Ada.Real_Time.Timing_Events;

Two routines are required due to the usual need to express absolute and
relative times. A call of Signal will return once the handler request is
registered. When the time indicated is reached (or the interval of time
expired) then the protected procedure associated with the handler will be
executed. As with the definition of the delay statements, clock granularity
issues may mean that the handler will be executed after the indicated time - it
will never be execute before.

The definition allows more than one call to Signal from the same task. Hence
more than one handler may need to be executed at the same time instance. The
order in which an implementation will execute these handlers is not defined.
Indeed the same handler may be registered on a number of occasions for
different (or indeed the same) time instance. We have decided not to include a
means of cancelling a future timing event. The overhead is allowing
cancellation is likely to be high. In terms of the API, the above definitions
would probably have to be modified so that calls to Signal would return some
form of ID that could then be used to cancel the event.

With any interrupt handler it is necessary to assign the correct ceiling
priority to the protected object that contains the handler. This is also the
case with these timing events. As the clock interrupt is often the highest in
the system we assume Interrupt Priority'Last will be required as the ceiling.
Note also that the protected object must be defined at the library level to
ensure it is visible.

3.1 Imprecise Computation Example Revisited

With this new facility the example given earlier is easily accommodated. Only a
single task is required (together with an appropriate protected object).

protected type Minder is
  pragma Priority Interrupt_Priority'Last;
  procedure Change; procedure Register;
private
  Id : Ada.Task_Identification.Task_Id;
end Minder;

protected body Minder is
  procedure Register is
  begin
    Id := Ada.Task_Identification.Current_Task;
  end Register;

  procedure Change is
  begin
    Ada.Dynamic_Priorities.Set_Priority(Mandatory_Pri,Id);
  end Change;
end Minder;

task body Example is
  Start_Time : Ada.Real_Time.Time:= Ada.Real_Time.Clock;
  Period : Ada.Real_Time.Time_Span:= Ada.Real_Time.Milliseconds(50);
  Deadline : Ada.Real_Time.Time_Span:= Ada.Real_Time.Milliseconds(40);
  Result : Some_Data_Type;
  Pri_Control : Minder;
begin
  Pri_Control.Register;
  loop
    -- code of the mandatory part, including
    Result := ...
    Store.Put(Result);
    Ada.Real_Time.Timing_Events.Signal(Start_Time + Deadline,
                                       Pri_Control.Change);
    select
      delay until Start_Time + Deadline;
    then abort
      Ada.Dynamic_Priorities.Set_Priority(Optional_Pri);
      loop
        -- code of the optional part, including
	Result := ...
	Store.Put(Result);
	-- note, no exit statement
      end loop;
    end select;
    Start_Time := Start_Time + Period;
    delay until Start_Time;
  end loop;
end Example;

3.2 Scheduling Implications

From a scheduling standpoint the use of timing events has two implications:

o The number of task is reduced and the cost of context switching to minder
tasks is eliminated.

o All tasks suffer interference from all timing events.

This clearly means that an application must consider the trade-off that the
facility provides. If the timing event handlers are long then it would be better
to encapsulate them in a task that can execute at the right priority. But if
they are short then then may as well be executed as part of
the clock interrupt handler that will
happen anyway. Remember there is no easy means of stopping all tasks suffering
interference from all delay expirations.

4 Delay Statements Revisited

By introducing timing events we are in effect opening up the implementation of
the delay mechanisms. A process known as reflection. Indeed once we have timing
events then a programmer can construct delay statements:

package Delay_Routines is
  -- routines for just one task
  procedure Del(Int : Time_Span);
    -- identical to delay
  procedure Del_Til(T : Time);
    -- identical to delay until
end Delay_Routines;

package body Delay_Routines is
  protected Delayer is
    pragma Priority Interrupt_Priority'Last;
    entry Del;
    procedure Now;
  private
    Continue : Boolean := False;
  end Delayer;

  protected body Delayer is
    entry Del when Continue is
    begin
      Continue := False;
    end Del;
    procedure Now is begin
      Continue := True;
    end Now;
  end Delayer;

  procedure Del(Int : Time_Span) is
  begin
    Ada.Real_Time.Timing_Events.Signal(Int,Delayer.Now);
    Delayer.Del;
  end Del;

  procedure Del_Til(T : Time) is
  begin
    Ada.Real_Time.Timing_Events.Signal(T,Delayer.Now);
    Delayer.Del;
  end Del_Til;

end Delay_Routines;

In the example given earlier in section 3.1, the return from the delay
statement and the signal were both programmed to occur at the same time. A more
efficient implementation would combine them:

protected type Minder is
  pragma Priority Interrupt_Priority'Last;
  procedure Change;
  procedure Register;
  entry Wake_Up;
private
  Id : Ada.Task_Identification.Task_Id;
  Optional_Over : Boolean := False;
end Minder;

protected body Minder is
  procedure Register is
  begin
    Id := Ada.Task_Identification.Current_Task;
  end Register;

  entry Wake_Up when Optional_Over is
  begin
    Optional_Over := False;
  end Wake_Up;

  procedure Change is begin
    Ada.Dynamic_Priorities.Set_Priority(Mandatory_Pri,Id);
    Optional_Over := True;
  end Change;
end Minder;

task body Example is
  Start_Time : Ada.Real_Time.Time:= Ada.Real_Time.Clock;
  Period : Ada.Real_Time.Time_Span:= Ada.Real_Time.Milliseconds(50);
  Deadline : Ada.Real_Time.Time_Span:= Ada.Real_Time.Milliseconds(40);
  Result : Some_Data_Type;
  Pri_Control : Minder;
begin
  Pri_Control.Register;
  loop
    -- code of the mandatory part, including
    Result := ...
    Store.Put(Result);
    Ada.Real_Time.Timing_Events.Signal(Start_Time + Deadline,
                                       Pri_Control.Change);
    select
      Pri_Control.Wake_Up;
    then abort
      Ada.Dynamic_Priorities.Set_Priority(Optional_Pri);
      loop
        -- code of the optional part, including
	Result := ...
	Store.Put(Result);
	-- note, no exit statement
      end loop;
    end select;
    Start_Time := Start_Time + Period;
    delay until Start_Time;
  end loop;
end Example;

5 Ravenscar Issues

At the last Workshop extensions to Ravenscar were discussed [6]. One
observation coming from some of the position papers was that Ravenscar plus
Dynamic Priorities represents a powerful set of facilities. In this paper we
have motivated the need for timing events by using the full set of tasking
features. However, the combination of Ravenscar plus Dynamic Priorities plus
timing events is a profile worthy of further evaluation.

6 Conclusions

Ada 95 contains a very flexible concurrency model and many real-time features.
This makes it the most general purpose real-time programming language in common
usage. Indeed the combination of ATCs and the use of dynamic priorities allows
a wide range of scheduling schemes to be supported. Unfortunately in many of
these schemes extra minder tasks are needed to manipulate priorities at
designated times.

Arguable a real-time programming language should provide more than one means of
bringing time and code together. In this paper we have investigated the use of
timing events that are execute directly by the run-time system. This appears to
be a powerful general purpose language primitive which Ada implementations are
able to provide with little effort.

References

[1] A. Burns and G. Bernat. Implementing a flexible scheduler in
Ada. In Reliable Software Technologies, Proceedings of
the Ada Europe Conference, Leuven, pages 179 - 190. Springer Verlag, LNCS 2043,
2001.

[2] A. Burns and A.J. Welling. Feature interaction with dynamic priorities. In
A.J. Wellings, editor, Proceedings of the 8th
International Real-Time Ada Workshop, pages 27-32. ACM Ada Letters, 1997.

[3] A. Burns and A. J. Wellings. Concurrency in Ada. Cambridge University
Press, 1995.

[4] J.W.S. Liu, K.J. Lin, W.K. Shih, AC. S. Yu, J.Y. Chung, and W.
Zhao. Algorithms for scheduling imprecise computations.
EEE Computer, pages 58-68, 1991.

[5] W. K. Shih, J. W. S. Liu, and J. Y. Chung. Algorithms for scheduling
imprecise computations with timing constraints. In Proc. IEEE Real-Time Systems
Symposium, 1989.

[6] A.J. Wellings. Status and future of the Ravenscar profile: Session summary.
In M.G. Harbour, editor, Proceedings of the 10th International Real-Time
Ada Workshop, pages 5-8. ACM Ada Letters, 2001.

****************************************************************

From: Tucker Taft
Sent: Thursday, September 5, 2002  9:56 AM

Alan Burns wrote:
> ...
> !proposal
>
> A child package of Ada.Real_Time is proposed.
>
> package Ada.Real_Time.Timing_Events is
>
>   type Timing_Event is limited private;
>
>   type Timing_Event_Handler(TE : in out Timing_Event)
>     is access protected procedure;

This should be:

    type Timing_Event_Handler is
      access protected procedure(TE: in out Timing_Event);

>
>   procedure Set_Handler(TE : in out Timing_Event; At_Time : Time;
>              Handler: Timing_Event_Handler);
>
>   procedure Set_Handler(TE : in out Timing_Event; In_Time: Time_Span;
>              Handler: Timing_Event_Handler);

Once you give a mode for one parameter, it seems to be "good form"
to use explicit rather than implicit "in" thereafter.
Hence, I would recommend adding "in" after "*_Time:" and "Handler:".

>
>   function Is_Handler_Set(TE : Timing_Event) return boolean;
>
>   function Current_Handler(TE : Timing_Event) return Timing_Event_Handler;
>
>   procedure Cancel_Handler(TE : in out Timing_Event);
>
>   function Time_Of_Event(TE : Timing_Event) return Time;
>
> private
>   ... -- not specified by the language
> end Ada.Real_Time.Timing_Events;
> ...

****************************************************************

From: Alan Burns
Sent: Thursday, September 5, 2002  10:09 AM

Thanks for stopping silly mistake with the parameter.

I'll note you advice about in paramters

****************************************************************

From: Robert A. Duff
Sent: Thursday, September 5, 2002  5:38 PM

> Once you give a mode for one parameter, it seems to be "good form"
> to use explicit rather than implicit "in" thereafter.
> Hence, I would recommend adding "in" after "*_Time:" and "Handler:".

For what it's worth, I don't agree with that advice.  My advice is:
Never use 'in'; always make it implicit.

I don't see the point in Tucker's advice on this point.

****************************************************************

From: Robert Dewar
Sent: Thursday, September 5, 2002  7:10 PM

I strongly agree with Bob here, I find gratuitous IN mode indications
(such as those that infest the RM) annoying :-)

****************************************************************

From: Tucker Taft
Sent: Thursday, September 5, 2002  9:07 PM

I think consistency with the rest of the RM is appropriate.
The general rule in the RM seems to be *always* use
explicit parameter modes on procedures.  For functions,
either always or never in a given package.

I don't believe we should be debating our own
personal styles here, but rather the de-facto "RM style."
That's what I meant by "good form."

****************************************************************

From: Robert A. Duff
Sent: Friday, September 6, 2002  7:39 PM

OK, fine.  You confused me by saying it has something to do with the
*previous* parameter, which is a rule I had never heard of.

****************************************************************

From: Robert Dewar
Sent: Friday, September 6, 2002  4:28 PM

<<I don't believe we should be debating our own
personal styles here, but rather the de-facto "RM style."
That's what I meant by "good form.">>

Yes, that makes sense, but it means that pushing a personal style of
giving modes once one mode has been given is also inappropriate :-)

****************************************************************

From: Tucker Taft
Sent: Friday, September 6, 2002  8:59 PM

Yes, I agree.  I was really making an imperfect guess
what was the RM style.  I took a closer look afterward
and discovered that we always used modes for procedures,
and always or never used them for functions in a given
package.

****************************************************************

From: Robert Dewar
Sent: Friday, September 6, 2002  9:25 PM

For the record, the reason I prefer to leave out IN (and object to the
implied recommendation in the RM) is that IN parameters are indeed the
normal case. OUT and IN OUT parameters are the exceptional cases, and
I prefer to use the keywords to point out the exceptional cases.

****************************************************************

From: Randy Brukardt
Sent: Thursday, January 2, 2003  4:22 PM

In finishing up the minutes, I came across the discussion about ways to
force these to be declared at the library level. We dreamt up a complex and
dangerous mechanism to handle that in AI-303. In thinking about that a bit,
I wonder if we aren't going about this entirely the wrong way.

Finalization is a core capability in Ada 95. It is used to perform all sorts
of tasks when objects go out of scope. For example, the canonical semantics
for protected objects uses finalization when they are destroyed.

Some real-time people claim that finalization is too expensive for their
applications. This is a rare special case (finalization takes very little
overhead, far less than a rendezvous, so this applies only to the most
critical applications). Thus, Ada provides ways to eliminate the overhead.
For example, the Ravenscar profile adds a Restriction
"No_Local_Protected_Objects" to eliminate this overhead. Why can't we use a
similar solution for timing objects?

That is, define the finalization of timing objects to unhook them properly.
Then, add a restriction "No_Local_Timing_Objects" to eliminate the (small)
overhead of finalization for critical real-time applications. (Presumably,
this restriction would be added to the Ravenscar profile).

Since we've decided to use a package-based approach for timing object, this
isn't even going to be very expensive to implement: a canonical timing
object can be derived from Limited_Controlled in the private part with a
private overriding Finalize. Then the existing language will do all of the
hard work. Ravenscar runtimes presumably would do something different
(depending on the restriction), but they typically are completely different
than a full runtime anyway.

****************************************************************


Questions? Ask the ACAA Technical Agent