Ada was the first language to include support for tasks (aka multi-threading) as part of the language itself. As such, it is often convenient to design a program to include a number of worker tasks that can split the work, and thus speed up the overall program.
Here is an example of such a worker task
package Pkg is
task type Worker (Num : Integer) is
entry Stop;
end Worker;
end Pkg;
with Ada.Text_IO;
package body Pkg is
task body Worker is
begin
accept Stop;
delay 1.0;
Ada.Text_IO.Put_Line ("worker exiting" & Num'Image);
end Worker;
end Pkg;
Of course, these tasks do nothing useful here, but they will serve the purpose for this blog post.
In general, a task needs a way to terminate cleanly, otherwise it will block the main program (or the subprogram in which the object was declared) which will itself never terminate. In this example, we have provided a Stop entry for that purpose.
Now, having a single worker would not be very useful to our program, since we really want a number of them to actually split the work. We could declare 10 local variables, of course, but it would be cleaner to have an array of such workers. But we have used a discriminated type here, so the type is unconstrained (its size might not be known at compile time), and therefore we cannot declare an array of Worker.
So instead we will use access types here, and of course provide a way to free them.
with Ada.Unchecked_Deallocation;
package Pkg is
... as before ...
type Worker_Access is access Worker;
type Worker_Access_Array is array (Natural range <>) of Worker_Access;
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Worker, Worker_Access);
end Pkg;We can now write our main program. It will simply declare 10 workers, and then immediately ask them to stop (I only pretend to do useful work when I am at the office…)
with Pkg;
procedure Main is
WA : Pkg.Worker_Access_Array (1 .. 10);
begin
-- Allocate and start the worker tasks
for T in WA'Range loop
WA (T) := new Pkg.Worker (Num => T);
end loop;
-- And immediately stop them
for T in WA'Range loop
WA (T).Stop;
Pkg.Unchecked_Free (WA (T));
end loop;
-- The worker tasks are still running, yet we have freed memory
null;
end Main;
We are well-behaved, and we learned that when we allocate memory, we must also deallocate it…
But when we run this program, the output looks like the following:
worker exiting 23484512
worker exiting 23498752
worker exiting 23527232
worker exiting 23584176
worker exiting 23470272
worker exiting 23541472
worker exiting 0
worker exiting 0
worker exiting 23569936
worker exiting 23512992
Instead of the worker numbers being between 1 and 10, they have seemingly random numbers… This is generally a sign of accessing uninitialized or freed memory. Let’s run the same program in valgrind to see whether it reports any issue.
==18612== Memcheck, a memory error detector
==18612== Copyright (C) 2002-2017, and GNU GPL’d, by Julian Seward et al.
==18612== Using Valgrind-3.15.0 and LibVEX; rerun with -h for copyright info
==18612== Command: ./main
==18612==
==18612== Thread 3 wa(2):
==18612== Invalid read of size 4
==18612== at 0x405046: pkg__workerTB (in /home/briot/dbc/deepblue/t3/main)
==18612== by 0x410EB8: system__tasking__stages__task_wrapper (in /home/briot/dbc/deepblue/t3/main)
==18612== by 0x4876608: start_thread (pthread_create.c:477)
==18612== by 0x49B6132: clone (clone.S:95)
==18612== Address 0x4a917a0 is 0 bytes inside a block of size 16 free’d
==18612== at 0x483CA3F: free (in /usr/lib/x86_64-linux-gnu/valgrind/vgpreload_memcheck-amd64-linux.so)
==18612== by 0x426D38: __gnat_free (in /home/briot/dbc/deepblue/t3/main)
==18612== by 0x40568C: _ada_main (in /home/briot/dbc/deepblue/t3/main)
==18612== by 0x404E24: main (in /home/briot/dbc/deepblue/t3/main)
==18612== Block was alloc’d at
==18612== at 0x483B7F3: malloc (in /usr/lib/x86_64-linux-gnu/valgrind/vgpreload_memcheck-amd64-linux.so)
==18612== by 0x426CDE: __gnat_malloc (in /home/briot/dbc/deepblue/t3/main)
==18612== by 0x405293: _ada_main (in /home/briot/dbc/deepblue/t3/main)
==18612== by 0x404E24: main (in /home/briot/dbc/deepblue/t3/main)
==18612==
worker exiting 2
worker exiting 3
worker exiting 9
worker exiting 6
worker exiting 8
worker exiting 1
worker exiting 5
worker exiting 10
worker exiting 7
worker exiting 4
Because valgrind doesn’t free memory immediately, we get numbers from 1 to 10 for the worker identifiers this time. But more importantly, valgrind reported an invalid read before. We are indeed accessing freed memory !
Looking at the Ada Reference Manual, in 13.11.2 (“Unchecked Storage Deallocation”), in paragraph 11, we read the following:
It is a bounded error to free a discriminated, unterminated task object. The possible consequences are:
– No exception is raised
– Program_Error or Tasking_Error is raised at the point of the deallocation
– Program_Error or Tasking_Error is raised in the task the next time it references any of the discriminants
In this case the compiler should ensure one of the three effects above happens, though this doesn’t preclude the program misbehaving afterwards. Here, we get no exception. It would be more helpful if the compiler raised Program_Error, alerting people to this trap.
So, how are we supposed to implement our code cleanly, and properly terminate the tasks ? The ARM mentions that the task must be terminated, so let’s wait for it to be terminated. Ada provides a Terminated attribute for that very purpose. Our main program now reads like:
with Pkg;
procedure Main is
WA : Pkg.Worker_Access_Array (1 .. 10);
begin
for T in WA'Range loop
WA (T) := new Pkg.Worker (Num => T);
end loop;
-- Ask all tasks to stop
for T in WA'Range loop
WA (T).Stop;
end loop;
-- Then wait for them to be terminated
for T in WA'Range loop
while not WA (T)'Terminated loop
delay 0.0001;
end loop;
-- And finally free the memory
Pkg.Unchecked_Free (WA (T));
end loop;
end Main;
And now the program runs cleanly in valgrind, and the task numbers are properly displayed
worker exiting 1
worker exiting 10
worker exiting 9
worker exiting 3
worker exiting 8
worker exiting 7
worker exiting 4
worker exiting 2
worker exiting 6
worker exiting 5
