Task Suspension with a Timeout in Ravenscar/Jorvik

by Pat Rogers – Oct 05, 2021

This blog entry shows how to define an abstract data type that allows tasks to block on objects of the type, waiting for resumption signals from other components, for at most a specified amount of time per object. This "timeout" capability has been available in Ada from the beginning, via select statements containing timed entry calls. But what about developers working within the Ravenscar and Jorvik tasking subsets? Select statements and timed calls are not included within either profile. This new abstraction will provide some of the functionality of timed entry calls, with an implementation consistent with the Ravenscar and Jorvik subsets.

In a previous blog entry we showed how to have a set of "conditions" that tasks can await, suspended, eventually to be awakened when "signaled" by some other task. Callers could await one of several conditions at the same time. However, these waiting callers blocked indefinitely, without a timeout option. That's often appropriate, but not in all cases. We will now take a different approach, defining a simpler version of "conditions" more like a condition variable or semaphore. Tasks still call Wait, now for a specific condition object passed as a parameter, and also specify how long they are willing to be suspended, waiting for some other task or interrupt handler to call Signal for that same object.

The reason these blog entries focus on "conditions" is that "condition synchronization" is one of the two forms of synchronization required for concurrent programming. (Mutual exclusion is the other form.) For example, a consumer task must wait until a shared buffer is not empty before it can remove a value from the buffer. Likewise, a producer task inserting items into the shared buffer must wait until the buffer is not full. Protected entry barriers exist for the sake of expressing these sorts of Boolean conditions. However, as mentioned, for Ravenscar and Jorvik use we need an alternative mechanism.

You should understand that this mechanism does not provide the full capabilities of timed entry calls. Condition objects are not entries, they are just flags, or events, and as such do not include an entry body that can provide application-specific functionality. Unlike a timed entry call, a call to Wait is not a request for a service to be provided (strictly, started to be provided) within a given time. Instead, a call to Wait requests notification that a condition has been satisfied, or if you like, an event has occurred, within the specified time. The analogue in full Ada would be a select statement containing a timed call to a protected entry with a null body. Any application-specific functionality corresponding with the Wait call's return -- that which a protected entry body would otherwise provide -- must be programmed separately from the call itself.

Ada defines some standard lower-level facilities that can be used to define synchronization mechanisms, as well as used directly by applications. The most important of these are within the subsets defined by Ravenscar and Jorvik. We will use some of them to define the new capability.

Having shown how to implement the facility within the Ravenscar and Jorvik subsets, we then provide a demonstration on bare-metal hardware.

The API

As usual, the new mechanism is designed as an abstract data type (ADT), hence a private type in Ada. As a synchronization mechanism, clients of the type have no business doing assignment between objects of this type, and language-defined equality on such objects makes no sense. Therefore, the type is limited as well as private. (As you will see, there is another good reason for the type to be limited.) The enclosing package, type declaration, and primitive subprogram declarations are as follows:

package Timed_Conditions is

type Timed_Condition is limited private;

procedure Wait
(This      : in out Timed_Condition;
Timed_Out : out Boolean);

procedure Wait
(This      : in out Timed_Condition;
Interval  : Time_Span;
Timed_Out : out Boolean);

procedure Signal (This : in out Timed_Condition);

private
...
end Timed_Conditions;

With this API clients can declare objects of type Timed_Condition and can pass them to calls to Wait and Signal. Procedure Wait is overloaded to allow expression of the timeout value either in terms of an absolute time, i.e., a point on the timeline, or a time interval. With the latter, the actual timeout is the sum of the time when the call takes place and the interval specified. Tasks calling Wait for a given Timed_Condition object suspend until either the time is reached or a call to Signal takes place for the same object. In both cases Wait returns a Boolean value indicating whether or not the call has returned due to the expiration of the time specified.

For example, we could declare an object of this type like so:

with Timed_Conditions;  use Timed_Conditions;

package User_Button is

Pressed : Timed_Condition;

...

end User_Button;

Let's say, arbitrarily, that we want to wait at most 2 seconds for Pressed to be signaled. The task in the code below does so:

with User_Button;
...
Time_Expired : Boolean;
Timeout      : constant Time_Span := Milliseconds (2_000); -- arbitrary
begin
loop
Wait (User_Button.Pressed, Timeout, Time_Expired);
if Time_Expired then
...
...
end Waiter;

The Implementation

As hinted earlier, Ada defines standard lower-level mechanisms useful for building new kinds of concurrency constructs. We will use two: "timing events" and "suspension objects," both appearing in the full definition of the ADT in the private part of the package.

The type Timing_Event is language-defined in the Ada.Real_Time.Timing_Events package. Objects of this type allow clients to specify a time when an "event" should occur. When that time is reached a user-defined protected procedure "handler" is invoked by the runtime library, performing whatever functional steps are required to implement the event. Clients may also cancel the future event, such that the handler will not be triggered. As you can imagine, this type will provide much of our timeout implementation. The pertinent parts of the API are as follows:

package Ada.Real_Time.Timing_Events is

type Timing_Event is tagged 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 : Time;
Handler : Timing_Event_Handler);

procedure Cancel_Handler
(Event     : in out Timing_Event;
Cancelled : out Boolean);

...

private
...
end Ada.Real_Time.Timing_Events;

Procedure Set_Handler allows clients to set a time when the given Timing_Event object is to be triggered, and, as well, to specify a pointer to the protected procedure to be invoked when the time is reached. Procedure Set_Handler is overloaded for convenience, the difference being a parameter of type Time_Span instead of type Time.

Note the formal parameter defined for the protected procedure handler, designated by the Timing_Event_Handler access type. Any handler must be a protected procedure with a conforming formal parameter profile.

Procedure Cancel_Handler cancels the timeout trigger for the given Timing_Event object. On return from the call the parameter Cancelled is True if the object was set prior to it being cancelled; otherwise, on return it is False. An object being "set" means that a timeout was pending and a pointer to a handler was currently assigned.

The other required lower-level mechanism, "suspension objects," is provided by the type Suspension_Object declared in the Ada.Synchronous_Task_Control package. The pertinent parts of that package are as follows:

package Ada.Synchronous_Task_Control is

type Suspension_Object is limited private;

procedure Set_True (S : in out Suspension_Object);

procedure Suspend_Until_True (S : in out Suspension_Object);

...
private
...
end Ada.Synchronous_Task_Control;

A Suspension_Object variable amounts to a thread-safe Boolean flag. Clients can call Set_True and Set_False to assign the values.

Most significantly, via procedure Suspend_Until_True a client task can suspend itself until the specified flag becomes True. However, at most one task can be suspended on a given Suspension_Object variable at any given moment. Violations of that constraint raise Program_Error.

Suspension_Object variables are initially False, automatically, and are set back to False automatically on return from a call to Suspend_Until_True. As a result, in typical code Set_False is not used.

The operations Set_True and Set_False are atomic with respect to each other and with respect to Suspend_Until_True.

The full declaration of our ADT using these two facilities is as follows:

with Ada.Real_Time;                use Ada.Real_Time;

package Timed_Conditions is

type Timed_Condition is limited private;

procedure Wait
(This      : in out Timed_Condition;
Timed_Out : out Boolean);

procedure Wait
(This      : in out Timed_Condition;
Interval  : Time_Span;
Timed_Out : out Boolean);

procedure Signal (This : in out Timed_Condition);

private

type Timed_Condition is new Timing_Event with record
Timed_Out        : Boolean := False;
Caller_Unblocked : Suspension_Object;
end record;

protected Timeout_Handler is
pragma Interrupt_Priority;
procedure Signal_Timeout (Event : in out Timing_Event);
end Timeout_Handler;
--  A shared, global PO defining the timing event handler procedure. All
--  objects of type Timed_Condition use this one handler. Each execution of
--  the procedure will necessarily execute at Interrupt_Priority'Last, so
--  there's no reason to have a handler per-object.

end Timed_Conditions;

Our type Timed_Condition is visible to clients as a limited private type, so they must use it accordingly. The full view of the type in the package private part, however, indicates that much more is possible.

In particular, the full type declaration in the private part extends type Timing_Event to define the Timed_Condition type. As a result, the new type inherits all the Timing_Event capabilities, and is a tagged type because Timing_Event is tagged.

However, by design, neither the inherited operations nor the tagged nature are made part of the client API. We only want Timed_Condition clients to have the Wait and Signal operations. Completing the type declaration via inheritance in the private part of the package, rather than the public part, achieves that effect. Clients only have compile-time visibility to the partial view defined before the package private part. In contrast, the private part and package body have the full view, so the inherited operations are available there and will provide most of our timeout semantics.

Furthermore, our extended type includes a Boolean component indicating whether a timeout occurred, and a Suspension_Object component used to block and unblock caller tasks.

We made Timed_Condition a limited type in the visible part of the package (the client's partial view) for the reasons stated initially. In fact, the language requires us to do so, because the full type declaration in the private part (the full view) is itself limited. That required correspondence between the partial and full view makes sense because the client's view must be realistic with regard to the operations possible. If the type really is limited, as defined by the full view, then assignment really isn't possible. It wouldn't make sense for the client's view to indicate that assignment is possible if it really isn't. (By the same token, if the full view is not limited, the partial view is not required to be limited, but can be. If the partial view is limited but the full view is not, clients simply cannot do something that the full view allows within the package, i.e., assignment.)

So, why is the full view of type Timed_Condition limited, even though the reserved word doesn't appear in our full view? It's because we are extending a limited type. Our new package is a client of Ada.Real_Time.Timing_Events so we have the partial view of type Timing_Event. That partial view is tagged and limited. Therefore any extension is also tagged and limited.

In addition to the completion for Timed_Condition, the private part of the package also declares a single protected object, the Timeout_Handler. This protected object declares the protected procedure that will be invoked whenever any Timing_Condition object has timed out. (Note the required formal parameter's type. More on that in a moment.)

When the Ceiling_Locking protocol is applied, as it is in both Ravenscar and Jorvik, the language requires Timing_Event handlers to execute at priority System.Interrupt_Priority'Last. The pragma Interrupt_Priority achieves that effect. (The expectation is that timeout handlers are executed directly by the clock interrupt handler.)

It may seem surprising to have a single handler routine shared amongst all Timed_Condition objects. This approach works for a few reasons. First, the formal parameter to the handler gives us the specific object that has been triggered. Second, and most important, under these two profiles all handlers for Timing_Events must execute at a priority of System.Interrupt_Priority'Last, so all handlers will execute atomically, not concurrently. Therefore there is no benefit to having a dedicated protected object per Timing_Condition object.

Given that full definition, here is the corresponding package body:

package body Timed_Conditions is

----------
-- Wait --
----------

procedure Wait
(This      : in out Timed_Condition;
Timed_Out : out Boolean)
is
begin
Suspend_Until_True (This.Caller_Unblocked);
Wait.Timed_Out := This.Timed_Out;
end Wait;

----------
-- Wait --
----------

procedure Wait
(This      : in out Timed_Condition;
Interval  : Time_Span;
Timed_Out : out Boolean)
is
begin
Wait (This, Clock + Interval, Timed_Out);
end Wait;

------------
-- Signal --
------------

procedure Signal (This : in out Timed_Condition) is
Handler_Was_Set : Boolean;
begin
This.Cancel_Handler (Handler_Was_Set);
if Handler_Was_Set then
--  a caller to Wait is suspended
This.Timed_Out := False;
Set_True (This.Caller_Unblocked);
end if;
end Signal;

---------------------
-- Timeout_Handler --
---------------------

protected body Timeout_Handler is

--------------------
-- Signal_Timeout --
--------------------

procedure Signal_Timeout (Event : in out Timing_Event) is
This : Timed_Condition renames Timed_Condition (Timing_Event'Class (Event));
begin
This.Timed_Out := True;
Set_True (This.Caller_Unblocked);
--  note: Event's pointer to a handler becomes null automatically
end Signal_Timeout;

end Timeout_Handler;

end Timed_Conditions;

When called, procedure Wait sets a timeout deadline for the specified Timed_Condition, along with a pointer to the shared Signal_Timeout handler, and then suspends the caller. If the time expires, Signal_Timeout sets the Boolean Timed_Out flag to True and then unblocks the suspended caller in Wait. If, on the other hand, procedure Signal is called prior to the timeout, the timeout is canceled, Timed_Out is set to False, and again the caller in Wait is unblocked. In either case the Wait caller is unblocked and the Caller_Unblocked variable goes back to False automatically. (It is False initially, automatically.) At that point the internal Timed_Out Boolean flag can be assigned to the Timed_Out formal parameter. Wait then exits.

Note that Signal could be called before a call to Wait has occurred for the same Timed_Condition object. And of course, it might be called after a timeout has expired. Therefore, the body of procedure Signal checks to see if Cancel_Handler actually cancelled an event timeout. It does this check via the Boolean parameter passed to Cancel_Handler, named Handler_Was_Set. If True, the timeout was pending, which means there was a caller suspended in Wait for this Timed_Condition object. In that case we set the Timed_Out Flag to False and unblock the suspended caller. If Handler_Was_Set is False, there was no pending timeout, hence no caller suspended in Wait, so nothing further is done.

An important aspect of the Timing_Event operations is that they are free of race conditions, per language rules, when operating on any given Timing_Event object. In addition, execution of Set_Handler is atomic with respect to the execution of the handler for that same object. Therefore, execution of these operations' internal statements will not be interleaved.

However, calls to them might be interleaved. For example, let's assume a task will call Wait and another task will call Signal, for the same Timed_Condition object. Wait could be about to make the call to Set_Handler, and then be preempted by the other task calling Cancel_Handler (via Signal). We know that Set_Handler and Cancel_Handler will be executed atomically, so either Set_Handler or Cancel_Handler will execute first, followed by the other. The if-statement in Signal ensures that either order works. If Set_Handler executes first, followed immediately by Cancel_Handler, the Boolean parameter Handler_Was_Set will return True and hence Caller_Unblocked will be set to True. When Wait resumes execution it will call Suspend_Until True but will find Caller_Unblocked True, so it will return immediately, and then finish Wait's execution. Alternatively, if Cancel_Handler executes first, Handler_Was_Set will be False and nothing further will be done in Signal. The call to Wait will then continue as usual, waiting for Signal to be called. The application must be structured such that another call to Signal does eventually occur, if that should happen prior to the timeout. These are not persistent signals.

Finally, recall we said there was something to mention about the formal parameter profile for Signal_Timeout. Specifically, the type for the formal parameter must always be type Timing_Event, otherwise such a protected procedure would not be compatible with the access type. The runtime system will automatically call Signal_Timeout for us if/when the timeout expires, and will pass the specific Timed_Condition object to the handler. But although it is a Timed_Condition object, the view is as a Timing_Event object because that is the type of the formal parameter. Therefore, we have to convert the view inside the procedure from type Timing_Event to type Timed_Condition. Without the conversion, the view as a Timing_Event parameter would not allow references in the handler body to the extension components Timed_Out and Caller_Unblocked. The syntax to do the view conversion is used in the renaming declaration. It's a bit ugly, but is always the same approach: convert "up" to the "base" type, i.e., the root class-wide type, and then "down" to the specific derived type. The compiler may issue code to check that the right target type is actually involved, or it might recognize the fact that, in this case, the view conversion is always correct.

The Example

Now that we have the facility in place, let's have an example. We'll use one of the STM32 Discovery Kit boards that has a user button and some LEDs on it. A task will call Wait on a Timed_Condition variable, and an interrupt handler for the user button will Signal that same Timed_Condition variable. If the user doesn't press the button prior to the timeout deadline, the waiting task will turn on the orange LED and turn off the green LED. If the user does press the button in time, the waiting task will turn on the green LED and turn off the orange LED. This processing continues until power is pulled.

First, here's the declaration for the library package containing the waiter task. Ravenscar and Jorvik require all tasks to be declared at the library level:

package LED_Controller is

end LED_Controller;

We'll take the default task priority and stack size for Control.

Next, the package body, which I promise is more interesting:

with Ada.Real_Time;  use Ada.Real_Time;
with STM32.Board;    use STM32.Board;
with User_Button;
with Timed_Conditions; use Timed_Conditions;

package body LED_Controller is

-------------
-- Control--
-------------

Time_Expired : Boolean;
Timeout      : constant Time_Span := Milliseconds (2_000); -- arbitrary
begin
loop
Wait (User_Button.Pressed, Timeout, Time_Expired);

if Time_Expired then
Orange_LED.Set;
Green_LED.Clear;
else
Orange_LED.Clear;
Green_LED.Set;
end if;
end loop;
end Control;

end LED_Controller;

As the comment indicates, the timeout of two seconds is entirely arbitrary.

Package STM32.Board defines the devices on the STM32F407 Discovery board. In this code we use the two LEDs and the blue user button. Package User_Button is defined here to declare the Timed_Condition variable Pressed, the button hardware initialization routine, and the button interrupt handler. Here's the package declaration:

with Timed_Conditions; use Timed_Conditions;

package User_Button is

procedure Initialize (Use_Rising_Edge : Boolean := True);

Pressed : Timed_Condition;

end User_Button;

There we see the variable and the hardware initialization procedure. The interrupt handler is declared within the package body:

with STM32.Board;   use STM32.Board;
with STM32.Device;  use STM32.Device;
with STM32.GPIO;    use STM32.GPIO;
with STM32.EXTI;    use STM32.EXTI;
with System;

package body User_Button is

Button_High : Boolean := True;

EXTI_Line : constant External_Line_Number := User_Button_Point.Interrupt_Line_Number;

------------
-- Button --
------------

protected Button with
Interrupt_Priority => System.Interrupt_Priority'Last
is
procedure Interrupt with
Attach_Handler => User_Button_Interrupt;
end Button;

------------
-- Button --
------------

protected body Button is

---------------
-- Interrupt --
---------------

procedure Interrupt is
begin
Clear_External_Interrupt (EXTI_Line);
if (Button_High and then User_Button_Point.Set)
or else (not Button_High and then not User_Button_Point.Set)
then
--  we would de-bounce the button, but no need for this demo
Timed_Conditions.Signal (Pressed);
end if;
end Interrupt;

end Button;

----------------
-- Initialize --
----------------

procedure Initialize (Use_Rising_Edge : Boolean := True) is
begin
Enable_Clock (User_Button_Point);
User_Button_Point.Configure_IO
((Mode      => Mode_In,
Resistors => (if Use_Rising_Edge then Pull_Down else Pull_Up)));
--  Connect the button's pin to the External Interrupt Handler
User_Button_Point.Configure_Trigger
(if Use_Rising_Edge then Interrupt_Rising_Edge else Interrupt_Falling_Edge);
Button_High := Use_Rising_Edge;
end Initialize;

end User_Button;

The protected procedure Button.Interrupt is the handler for the interrupt, not surprisingly. When the hardware interrupt occurs, if the physical button has been pressed Signal is called. The details of setting up the interrupt are not particularly pertinent. It is worth mentioning, for the sake of clarity, that User_Button_Point is a GPIO port/pin pair that is defined by package STM32.Board.

Finally, the main procedure. The task and interrupt handler do all the work, but the main procedure first initializes the hardware, including the two LEDs.

with Ada.Real_Time; use Ada.Real_Time;
with Last_Chance_Handler;  pragma Unreferenced (Last_Chance_Handler);
--  The "last chance handler" is the user-defined routine that is called when
--  an exception is propagated. We want it in the executable, therefore it
--  must be somewhere in the closure of the context clauses.
with STM32.Board;
with System;
with LED_Controller; pragma Unreferenced (LED_Controller);
with User_Button;

procedure Test is
pragma Priority (System.Priority'Last);
begin
STM32.Board.Initialize_LEDs;
STM32.Board.All_LEDs_Off;
User_Button.Initialize;

loop
delay until Time_Last;
end loop;
end Test;

The main procedure specifies the highest non-interrupt priority for the environment task so all the hardware initialization occurs first. The task in package LED_Controller is activated automatically, and eventually calls Wait. At some point someone will press the physical button on the board, generating the interrupt. The LEDs will be lit accordingly.

The use of pragma Unreferenced prevents the compiler from issuing warnings about the fact that the main procedure doesn't do anything with certain packages. Ordinarily we'd want such warnings. But if they are not referenced, why mention them? For the packages to appear in the executable, they must appear somewhere in the transitive closure of the with-clauses. There's no reference to them elsewhere in the example code, so we pull them in here, in the main, and tell the compiler that it's OK.

After setting up the hardware, the main procedure goes into an infinite loop. That's required because tasks in Ravenscar and Jorvik should never complete and terminate -- including the implicit environment task that calls the main procedure. My personal preference is to have an extremely long delay inside the loop so that the main doesn't consume CPU cycles. But a null loop would work too, as long as the environment task is given a priority lower than any tasks that will be doing actual application processing. In this example we wanted the main procedure to do something before the Control task, without actually synchronizing with the task, so we gave it the highest priority. With that priority something that actually suspended the environment task was required, rather than a null loop. An elegant alternative to the long delay would be to suspend on another Suspension_Object variable that will never be set to True. (Thanks to Bob Duff for that suggestion.)

The code we used for the STM32 board and drivers is part of the Ada Drivers Library (ADL) provided by AdaCore and the Ada community. The ADL is available on GitHub for both non-proprietary and commercial use here: https://github.com/AdaCore/Ada_Drivers_Library.

As always, questions and comments are welcome!