Timeout Blocking Requests in Ada
In a project I'm working on I wanted to perform a blocking procedure call
(more specifically, XNextEvent to get the next keyboard event from
the X11 server). Except I didn't want it to be fully blocking. I wanted to be
notified whenever 0.5 seconds had passed while waiting for the call.
Since I was working in Ada, it seemed like tasks could help me here. Tasks are Ada primitives for concurrency and message passing. Cool stuff. However, it wasn't entirely clear how to use them in order to reach my goal. I managed to figure it out after a while, so I'll share a minimal working example in case someone else needs the same thing.
By the way: if you've ever worked with actors in Erlang, Ada tasks are surprisingly similar...
Single Request
There are two versions of this code, one which performs a single request, and one which sits in a continuous loop and performs a new request as soon as the previous request has been processed. The single request version is the simpler of the two, but it can be turned into the continuous-request version with only a couple of tweaks. It was the latter that I really needed, but I'll show you the simpler one in its entirety first below. First, however, an illustration of what it looks like when it is run.
$ ./test
Starting to perform the request...
Waiting for the request to complete.
Request finished, took 2384 milliseconds.
$ ./test
Starting to perform the request...
Waiting for the request to complete.
Request timed out.
$with Ada.Text_IO;
with Ada.Numerics.Float_Random; -- For our mock request
procedure Main is
-- The response we'll get from our long request
subtype Response is Natural range 1 .. 10_000;
-- A function that performs a request that can take a long time.
-- You don't need to understand all of it, but basically it
-- generates a random floating point number between 0 and 10,
-- pauses for that number of seconds, and then returns how many
-- milliseconds it has waited for.
function Takes_A_Long_Time return Response is
package Random renames Ada.Numerics.Float_Random;
Generator : Random.Generator;
Time : Duration;
begin
Random.Reset (Generator);
Time := Duration (Random.Random (Generator) * 10.0);
delay Time;
return Natural (Time * 1_000);
end Takes_A_Long_Time;
-- The specification of a task (background process) that will run
-- our Takes_A_Long_Time function.
task Long_Request is
-- Tasks are started in background processes automatically, so
-- this entry will ensure the task is paused until we are ready
-- to calculate the result. You can think of task entries as
-- "messages" which they wait for.
entry Start;
-- This is what we will call to get the result out. Tasks cannot
-- "return" values through entries, but they can take out parameters
-- which can be used to communicate information out of tasks.
entry Get_Result (Result : out Response);
end Long_Request;
-- The actual definition of our task.
task body Long_Request is
-- Tasks encapsulate local variables and state. In fact, there's a
-- lot of similarity between tasks and state machines that are run
-- concurrently with the rest of your code.
Time_Taken : Response;
begin
-- As soon as the Main procedure runs, this code will start running
-- in a separate process. To "pause" this task and wait for the
-- main procedure, the first line of the Long_Request task is an
-- accept statement which waits for the Start message before it
-- continues.
--
-- An entry/message is a little like a procedure, except when it is
-- encountered in task code, the task will pause and wait until
-- the entry is called.
accept Start;
-- After we have received the Start message, we begin our long running
-- request.
Time_Taken := Takes_A_Long_Time;
-- When the request is completed, we can do one of two things:
select
-- 1. Either we accept a Get_Result message and return the time
-- taken through its out parameter;
accept Get_Result (Result : out Response) do
Result := Time_Taken;
end Get_Result;
or
-- 2. If we don't receive a Get_Result message, we terminate.
terminate;
end select;
end Long_Request;
-- A variable for our main procedure to store the request result
Final_Result : Response;
begin
Ada.Text_IO.Put_Line ("Starting to perform the request...");
-- Send a message to the Long_Request task such that it "unpauses" and
-- goes on to perform the request.
Long_Request.Start;
Ada.Text_IO.Put_Line ("Waiting for the request to complete.");
-- The select statement is sort of a "timed branch", or a "temporal case
-- statement". There are three common forms of it.
--
-- 1. (selective-accept) You specify a message you accept in each branch,
-- and it runs the code for the branch that first receives a message.
--
-- 2. (conditional call) You specify a message you want to send to a task
-- and an else branch. If the task receives your message immediately,
-- the message branch is run. Otherwise the else branch is run.
--
-- 3. (timed call) As above, you specify a message you want to send to a
-- task, and in an "or" branch you specify a delay you are willing to
-- wait for. If the message has not been received within the delay,
-- the timeout branch is run instead.
--
-- In this case, we're obviously interested in the third form.
select
-- Try to send a Get_Result message to the Long_Request task.
Long_Request.Get_Result (Final_Result);
-- If it is received, print the result of the request.
Ada.Text_IO.Put_Line ("Request finished, took" & Response'Image (Final_Result) & " milliseconds.");
or
-- Also try to wait five seconds. If five seconds passed, the
-- request has timed out and we exit the program.
--
-- (Oh, the program will not actually quit until the long
-- request is finished, as a safety measure (imagine the long
-- running request is a life-sustaining operation, or whatnot.))
delay 5.0;
Ada.Text_IO.Put_Line ("Request timed out.");
end select;
end Main;Continuous Requests
Below is a modified version of the above, which intead performs new requests as soon as the previous one is complete. It has fewer comments because there's very little that's actually new in it compared to the previous snippet.
It's worth mentioning that this will not "cancel" the pending request and discard the result from it if it times out. Instead, the result from the previous request will be immediately returned the next iteration of the main loop. This is intended behaviour in my case. If you want to perform a new request (and ignore the previous response) once the old request times out, you can add a "Timeout" entry to the selective accept and send the Timeout message when it times out.
As before, you can first get an idea of what it performs by observing the output:
$ ./test_loop
Attempting to perform 10 requests...
Request finished, took 1328 milliseconds.
Request finished, took 299 milliseconds.
Request finished, took 2842 milliseconds.
Request finished, took 2123 milliseconds.
Request finished, took 1553 milliseconds.
Request finished, took 1387 milliseconds.
Request finished, took 2413 milliseconds.
Of 10 requests, 3 timed out.
$with Ada.Text_IO;
with Ada.Numerics.Float_Random; -- For our mock request
procedure Main_Loop is
subtype Response is Natural range 1 .. 10_000;
function Takes_A_Long_Time return Response is
package Random renames Ada.Numerics.Float_Random;
Generator : Random.Generator;
Time : Duration;
begin
Random.Reset (Generator);
Time := Duration (Random.Random (Generator) * 3.0);
delay Time;
return Natural (Time * 1_000);
end Takes_A_Long_Time;
-- In this case we don't have a Start entry, because the request is
-- going to be run continuously.
task Long_Request is
entry Get_Result (Result : out Response);
end Long_Request;
task body Long_Request is
Time_Taken : Response;
begin
-- We don't have a start entry, we simply start performing the
-- request as soon as the Main_Loop procedure starts.
loop
Time_Taken := Takes_A_Long_Time;
select
accept Get_Result (Result : out Response) do
Result := Time_Taken;
end Get_Result;
or
terminate;
end select;
end loop;
end Long_Request;
Final_Result : Response;
-- Count how many timeouts we have
Timeouts : Natural := 0;
begin
Ada.Text_IO.Put_Line ("Attempting to perform 10 requests...");
for I in 1 .. 10 loop
select
Long_Request.Get_Result (Final_Result);
Ada.Text_IO.Put_Line ("Request finished, took" & Response'Image (Final_Result) & " milliseconds.");
or
delay 2.0;
Timeouts := Timeouts + 1;
end select;
end loop;
Ada.Text_IO.Put_Line ("Of 10 requests," & Natural'Image (Timeouts) & " timed out.");
end Main_Loop;