Thomas Løcke Being Incoherent

Using the Ada Web Server (AWS), part 2

Thomas Løcke — Sun, 10 Mar 2013 12:38:44 +0000

In the Using the Ada Web Server (AWS), part 1 article I showed you how to setup a simple Hello world! server powered by the awesomeness that is the Ada Web Server (AWS) project. In this second part I will show you how to utilize the Templates_Parser module to build your HTML and I’ll also give a very short example on how to serve a flat file to visitors.

If you haven’t already read part 1, I strongly suggest doing so before proceeding with this article, as we will be building upon the code from part 1 in the following. I will not waste time on how to get the server going, or how to setup a dispatcher. We will jump straight into the template fray.

But first things first:

$ git clone git://github.com/ThomasLocke/AWS_Tutorial_2.git

The instructions on how to compile and run the program are the same as for part 1 of the article.

So what exactly is the point of using templates to generate your content, instead of just building the HTML directly in the Ada code? Well there are several good reasons for using templates:

With templates you don’t have to re-compile due to changes in the HTML.
With templates you get a very strong separation between logic and view.
With templates you can easily localize content by simply loading a different template file based on user preferences/IP address/whatever.
Your HTML people won’t need to learn a single line of Ada. They can stick to what they are good at.

There are probably more good reasons, but the ones mentioned above should be more than enough to convince you that using a template system is a good idea.

Lets take a peek at a very simple template file:

Not found

Resource @_RESOURCE_@ not found

As you can see it looks very much like normal HTML except for the special @_RESOURCE_@ tag (third line from below), which is what turns this otherwise plain looking HTML snippet into a proper template: @_RESOURCE_@ is a template tag that is replaced by some value defined in the Ada code. As you might’ve guessed this template is used to generate the “404 not found” content, so lets see how the Ada code looks now that we’ve moved the HTML into a template. This is our new Generate_Content function from the src/not_found.adb file:

with AWS.Messages;
with AWS.MIME;
with AWS.Response;
with AWS.Status;
with AWS.Templates;

package body Not_Found is

   --  Stuff...

   ------------------------
   --  Generate_Content  --
   ------------------------

   function Generate_Content
     (Request : in AWS.Status.Data)
      return AWS.Response.Data
   is
      use AWS.Templates;

      Resource : constant String := AWS.Status.URI (Request);

      Translations : Translate_Set;
   begin
      Insert (Translations, Assoc ("RESOURCE", Resource));

      return AWS.Response.Build
        (Content_Type  => AWS.MIME.Text_HTML,
         Message_Body  => Parse ("templates/not_found.tmpl", Translations),
         Status_Code   => AWS.Messages.S404);
   end Generate_Content;

end Not_Found;

If you compare it to the src/not_found.adb file from part 1 you’ll notice that the changes really aren’t that huge, but lets start at the top: At line 5 we with AWS.Templates; to bring in the templates parser module. With that we now have all the templating power at out fingertips.

The next change happens in the declarative part of Generate_Content where we now have a Use AWS.Templates; line and a Translations : Translate_Set; line. A Translate_Set is basically a dictionary to which you add your tags and their associated values, and to see how that is done we go down two lines to the Insert (Translations, Assoc ("RESOURCE", Resource)); line. Starting from the inside we associate the value of the Resource string with the template tag RESOURCE using the Assoc procedure and then we add the association to Translations with the Insert procedure.

Note that if you insert an association that already exists, then the existing association is overwritten by the new association.

In order to use the Translations dictionary we’ve created, we must call the AWS.Templates.Parse function:

function Parse
  (Filename          : String;
   Translations      : Translate_Set;
   Cached            : Boolean               := False;
   Keep_Unknown_Tags : Boolean               := False;
   Lazy_Tag          : Dyn.Lazy_Tag_Access   := Dyn.Null_Lazy_Tag;
   Cursor_Tag        : Dyn.Cursor_Tag_Access := Dyn.Null_Cursor_Tag)
   return String;

Only Filename and Translations are required, so that is exactly what we’re going to give Parse:

return AWS.Response.Build
  (Content_Type  => AWS.MIME.Text_HTML,
   Message_Body  => Parse ("templates/not_found.tmpl", Translations),
   Status_Code   => AWS.Messages.S404);

Parse then goes to work, matching all the added associations to the tags found in the template file, which in our case means replacing @_RESOURCE_@ with the value of RESOURCE.

And that is all. The 404 not found content is now fully templated.

Next lets take a peek at Generate_Content from src/hello_world.adb where we use a few more features from the AWS.Templates module:

with AWS.Messages;
with AWS.Templates;

package body Hello_World is

   --  Stuff...

   ------------------------
   --  Generate_Content  --
   ------------------------

   function Generate_Content
     (Request : in AWS.Status.Data)
      return AWS.Response.Data
   is
      use AWS.Templates;

      type Natural_List is array (0 .. 9) of Natural;
      Fibs : Natural_List;

      Browser : constant String := AWS.Status.User_Agent (Request);

      Fibonacci    : Vector_Tag;
      Position     : Vector_Tag;
      Translations : Translate_Set;
   begin
      Insert (Translations, Assoc ("BROWSER", Browser));

      for i in Fibs'Range loop
         case i is
            when 0 => Fibs (i) := 0;
            when 1 => Fibs (i) := 1;
            when others => Fibs (i) := Fibs (i - 1) + Fibs (i - 2);
         end case;

         Append (Position, i);
         Append (Fibonacci, Fibs (i));
      end loop;

      Insert (Translations, Assoc ("POSITION", Position));
      Insert (Translations, Assoc ("FIBONACCI", Fibonacci));

      return AWS.Response.Build
        (Content_Type  => AWS.MIME.Text_HTML,
         Message_Body  => Parse (Filename     => "templates/hello_world.tmpl",
                                    Translations => Translations,
                                    Cached       => True),
         Status_Code   => AWS.Messages.S200);
   end Generate_Content;

end Hello_World;

Let me start by saying that my Fibonacci implementation probably isn’t fast nor elegant, but it works and it doesn’t clutter the example with a whole bunch of code, and really the interesting part here is not how the Fibonacci sequence is generated but how it is added to the Translations Translate_Set. For this we have the Vector_Tag, which in all its simplicity allows us to build lists of values. As you can see we have two such vector tags: Fibonacci and Position. These two are populated by the Append calls in the for loop:

for i in Fibs'Range loop
   case i is
      when 0 => Fibs (i) := 0;
      when 1 => Fibs (i) := 1;
      when others => Fibs (i) := Fibs (i - 1) + Fibs (i - 2);
   end case;

   Append (Position, i);
   Append (Fibonacci, Fibs (i));
end loop;

Append add the values of i and Fibs (i) to Position and Fibonacci respectively. In case you're wondering about what kinds of data you can append to a vector, here's the specification of all the Append procedures:

procedure Append (T : in out Tag; Value : String);
procedure Append (T : in out Tag; Value : Character);
procedure Append (T : in out Tag; Value : Boolean);
procedure Append (T : in out Tag; Value : Unbounded_String);
procedure Append (T : in out Tag; Value : Integer);
procedure Append (T : in out Tag; Value : Tag);

Note the last one: Yes, you can append a vector tag to a vector tag, making it possible to build multi-dimensional arrays.

Adding our vector tags to Translations is still done using the Insert procedure, so nothing new there.

Finally we generate the content with Parse, where it is worth noting that we've now added the Cached => True parameter. What this does is allow the AWS.Templates module to cache the template itself. If you do this the server no longer read and parse the template file on every hit. The downside is that if you make changes to the template file, you will have to restart the server for the changes to be registered.

Now lets see how we deal with vector tags and do some other tricks in the template file:

@@-- @@-- First we define a macro. @@-- @@MACRO(F)@@ F@_$1_@ @@END_MACRO@@ @@-- @@-- And then comes the actual HTML5 document @@-- Hello world!

Hello world!

Browser used : @_BROWSER_@

Fibonacci's from 0 to 9

@@TABLE@@ @@END_TABLE@@

@_F(@_POSITION_@)_@

@_FIBONACCI_@

Now is @_NOW_@

Now reversed is @_REVERSE:NOW_@

Click here to see the hello_world.tmpl file.

Lines starting with @@-- are comments.

At line three we define a macro with the name F. When you call macros you can give them parameters which are then referenced in the macro as @_$n_@, where n corresponds to the N.th. parameter passed to the macro.

Moving on we add the visitors browser to the HTML using the @_BROWSER_@, and just below that we build the Fibonacci table, and here we encounter the @@TABLE@@ tag. Code between the @@TABLE@@ and @@END_TABLE@@ tags are repeated as many times as there are values in the POSITION and FIBONACCI vectors. @@TABLE@@ acts very much like an implicit iterator. Much fun can be had with the @@TABLE@@ tag - this example is the very simplest way to utilize it. Check the manual for more extensive examples.

There's a few more tricks in this template worth mentioning. The templates parser module sports a bunch of constants and filters, one of these being @_NOW_@ which is replaced with a time stamp in the format "YYYY-MM-DD HH:MM:SS". At the next line we reverse the contents of @_NOW_@ using the @_REVERSE:VAR_@ filter. There's a whole bunch of filters available and multiple filters can be applied to tags for pure awesomeness. As an added bonus you can even create your own filters.

And that was all I had about the templates parser module, but before I end this article I'd like to direct your attention to this new dispatcher in src/handlers.adb:

Dispatcher.Register (URI    => "/helloworld.tmpl",
                     Action => Hello_World.Hello_World_Template'Access);

The goal of this dispatcher is to return the contents of the exe/templates/hello_world.tmpl file to the user as text/plain. The Hello_World.Hello_World_Template function takes care of that:

function Hello_World_Template
  (Request : in AWS.Status.Data)
   return AWS.Response.Data
is (AWS.Response.File (AWS.MIME.Text_Plain,
                       "templates/hello_world.tmpl"));

That right there is an Ada 2012 expression function. Since all this function does is call AWS.Response.File we don't really need a body. Expression functions provides a shorthand to declare a function whose body consists of a single return statement. That is IMHO one very nice feature of Ada 2012.

And with that final piece of AWS.Response.File magic I will close this article. Stay tuned for part 3, where I plan on showing you a bit about how to handle HTTP request parameters using the Ada Web Server.

Using the Ada Web Server (AWS), part 1

Thomas Løcke — Sun, 10 Feb 2013 15:27:27 +0000

The Ada Web Server (AWS) is a big library with a whole lot of functionality, far more than I can manage to write about, so what I am going to do in this first article is focus on the basic stuff: Getting a server up and registering a couple of content handlers.

Before we move on lets get two things out of the way:

Make sure you have AWS installed on your system
Git clone the code from this article from here

If you’re having trouble getting AWS up and running, you could take a look at an article I wrote a while ago about Ada Programming on Slackware. Even if you’re not using Slackware there might be some tricks in there that also apply to your favorite distro. If you’re using Windows I really can’t help you, as I know very little about getting Ada and AWS up and running on that line of operating systems.

What is most important though, is that you grab the latest AWS from the Git repository:

$ git clone --recursive http://forge.open-do.org/anonscm/git/aws/aws.git

At the time of writing the latest commit in the repository was ffc79ac63f06e44100bc69de59eb4ed9b76c41ae (Date: Tue Feb 5 18:48:37 2013 +0100), so assume that you at least need an AWS that is as new as that.

From now on I’m going to assume that you’ve got a sufficiently new AWS working and the tutorial code cloned from my Github repository, so lets get rocking with some AWS magic.

We start by building and trying the tutorial program you cloned earlier, so we know what we’re getting into:

$ cd Ada_Web_Server_Tutorial_1/
$ make
$ cd exe/
$ ./aws_tutorial

Grab your browser and do as instructed; go to localhost:8080 and see what you get. Nice eh’? A sexy 404 message hosted by your very own Ada powered webserver. Whooooosh! If you don’t like the 404, try visiting localhost:8080/helloworld for something else. When you’re done being amazed click q to kill the server.

So how did this magic come to life? We zoom to the main program file aws_tutorial.adb for some enlightenment:

with Ada.Text_IO;
 
with AWS.Config;
with AWS.Default;
with AWS.Server;
 
with Handlers;
 
procedure AWS_Tutorial is
   Web_Server : AWS.Server.HTTP;
begin
   Ada.Text_IO.Put_Line
     ("I'm available at localhost port"
      & Positive'Image (AWS.Default.Server_Port)
      & ". Press q to kill me.");
 
   Ada.Text_IO.Put_Line ("http://localhost:8080/helloworld");
 
   AWS.Server.Start (Web_Server => Web_Server, 
                     Dispatcher => Handlers.Get_Dispatcher, 
                     Config => AWS.Config.Get_Current);
 
   AWS.Server.Wait (AWS.Server.Q_Key_Pressed);
 
   AWS.Server.Shutdown (Web_Server);
end AWS_Tutorial;

Simplicity at work eh’? Lets stroll through the code together.

First we with a bunch of packages: Ada.Text_IO is for text input/output, and that is exactly what we’re using it for at line 12 where we output the port and kill instructions. After that we add three AWS packages, of which the first two are dealing with the configuration of the AWS HTTP server, specifically the default settings and loading of any external configuration files. The call to AWS.Config.Get_Current at line 19 searches for the files aws.ini and progname.ini (in our case aws_tutorial.ini) in the same location as the executable, and if any of these are found the values set here are used to configure the Web_Server object that is started at line 17 by the AWS.Server.Start call. If you take a peek at the exe/aws.ini file you'll see that the only value we're setting is Reuse_Address True. What this does is allow us to start and stop the server without having to wait for the system to release the socket. The rest of the configuration is inherited from the AWS.Default package.

We'll ignore the call to Handlers.Get_Dispatcher for now and move further down to line 21 where we're abruptly stopped by the AWS.Server.Wait (AWS.Server.Q_Key_Pressed) call. What is this weird contraption? Well a server needs some sort of "loop" to prevent it from terminating, and this is exactly one such loop, except it isn't really a loop. What Wait does is hang until some specific event occurs, in our case it is waiting for someone to click the q key. As soon as Wait registers some action on the q key it returns and the program moves on to the final statement; the AWS.Server.Shutdown (Web_Server) call. I'm guessing that it is evident what this does. It cleanly shuts down the server and when it is done, the program exits.

And that is really all that is required to add HTTP(s) support to your Ada program.

But wait, how do we generate the content? Ahh, yes now we'll take a closer look at the Handlers.Get_Dispatcher call at line 18. What is this dispatcher thing we're getting? It's simple really. In order for the server to know what to do with all the requests coming in, we need to define some handlers. This is done in the homegrown Handlers.Get_Dispatcher function that lives a groovy life in the Handlers package found in the src/handlers.ad[sb] files. Lets take a peek at the specification file first:

with AWS.Services.Dispatchers.URI;
 
package Handlers is
 
   function Get_Dispatcher
     return AWS.Services.Dispatchers.URI.Handler;
   --  Return the content handlers for our server.
 
end Handlers;

Not much happening here. We define the Get_Dispatcher function which return a AWS.Services.Dispatchers.URI.Handler. The name of the returned type should give away that we're dispatching HTTP request based on the URI of the requested resource. There are a bunch of other dispatchers available in AWS, but for now we'll stick to the basic URI stuff.

The body is a bit more interesting:

with Hello_World;
with Not_Found;
 
package body Handlers is
 
   ----------------------
   --  Get_Dispatcher  --
   ----------------------
 
   function Get_Dispatcher
     return AWS.Services.Dispatchers.URI.Handler
   is
      Dispatcher : AWS.Services.Dispatchers.URI.Handler;
   begin
      Dispatcher.Register_Default_Callback (Action => Not_Found.Callback);
      --  The default callback is going to be our 404 not found handler. If
      --  a requested resource isn't specifically defined here, we're going
      --  to return a 404 to the client.
 
      Dispatcher.Register (URI    => "/helloworld",
                           Action => Hello_World.Callback);
      --  The /helloworld resource.
 
      return Dispatcher;
   end Get_Dispatcher;
 
end Handlers;

The two packages we with contains the code that generates our content. We need them here because this is the place where we register the resource handlers.

We declare the Dispatcher object as an URI.Handler at line 13 and then we proceed with registering two handlers: A default handler at line 15 and a specific /helloworld handler at line 20. Finally we return the Dispatcher object.

The default handler is the Not_Found.Callback function, which means that whenever a resource is requested that doesn't specifically match a registered URI, the Not_Found.Callback function is called. On the other hand if the /helloworld resource is requested, the Hello_World.Callback function is called.

This is how dispatching in AWS works. But it is not the only way. It is also possible to manually dispatch based on the string URL of a request, but that is very clumsy and ugly. You really should use the dispatcher model if you're working with AWS as it offers both convenience and some nice tools to build and maintain your resource->handler structure.

Moving on lets take a peek at the Not_Found package where we handle the 404's:

with AWS.Dispatchers.Callback;
 
package Not_Found is
 
   function Callback
     return AWS.Dispatchers.Callback.Handler;
   --  Return a callback for the Not_Found (404) response.
 
end Not_Found;

Here we see the Callback function that we registered in the Handlers.Get_Dispatcher function. And that is really all we make available to the world in the specification of this package. Lets check out the body:

with AWS.Messages;
with AWS.MIME;
with AWS.Response;
with AWS.Status;
 
package body Not_Found is
 
   function Generate_Content
     (Request : in AWS.Status.Data)
      return AWS.Response.Data;
   --  Generate the 404 response.
 
   ----------------
   --  Callback  --
   ----------------
 
   function Callback
     return AWS.Dispatchers.Callback.Handler
   is
   begin
      return AWS.Dispatchers.Callback.Create (Generate_Content'Access);
   end Callback;
 
   ------------------------
   --  Generate_Content  --
   ------------------------
 
   function Generate_Content
     (Request : in AWS.Status.Data)
      return AWS.Response.Data
   is
      Resource : constant String := AWS.Status.URI (Request);
   begin
      return AWS.Response.Build
        (Content_Type  => AWS.MIME.Text_HTML,
         Message_Body  =>
           "Not found
" &
           "Resource '" & Resource & "' not found
",
         Status_Code   => AWS.Messages.S404);
   end Generate_Content;
 
end Not_Found;

Ahh, this is far more interesting. Starting with the Callback function we see that all it does is return an AWS.Dispatchers.Callback.Handler. This is done using the Create function which takes an AWS.Response.Callback as its single parameter. The signature of the AWS.Response.Callback is this:

type Callback is access function 
  (Request : AWS.Status.Data) return AWS.Response.Data;

And that is exactly the signature of the Generate_Content function. It's marvelous how these things just come together like hand in glove. In Generate_Content we build the response sent to clients requesting unknown resources. This is all done in the AWS.Response.Build call. We define the Content_Type as text/html, we generate the actual content and finally we set the Status_Code to 404.

Pay special attention to line 32 where we grab the requested URI from the Request object. There's a lot of interesting data in this object. Take a peek at the AWS.Status package for more on how to entice this object to give up its secrets.

For the sake of completeness lets also take a peek at the Hello_World package:

with AWS.Dispatchers.Callback;
 
package Hello_World is
 
   function Callback
     return AWS.Dispatchers.Callback.Handler;
   --  Return a callback for the Hello World! response.
 
end Hello_World;

with AWS.Messages;
with AWS.MIME;
with AWS.Response;
with AWS.Status;
 
package body Hello_World is
 
   function Generate_Content
     (Request : in AWS.Status.Data)
      return AWS.Response.Data;
   --  Generate the Hello World! response.
 
   ----------------
   --  Callback  --
   ----------------
 
   function Callback
     return AWS.Dispatchers.Callback.Handler
   is
   begin
      return AWS.Dispatchers.Callback.Create (Generate_Content'Access);
   end Callback;
 
   ------------------------
   --  Generate_Content  --
   ------------------------
 
   function Generate_Content
     (Request : in AWS.Status.Data)
      return AWS.Response.Data
   is
      Browser : constant String := AWS.Status.User_Agent (Request);
   begin
      return AWS.Response.Build
        (Content_Type  => AWS.MIME.Text_HTML,
         Message_Body  =>
           "Hello World!
" &
           "Browser used : " & Browser & "
",
         Status_Code   => AWS.Messages.S200);
   end Generate_Content;
 
end Hello_World;

As you can see this is very similar to Not_Found, which is only natural since both packages do nearly the same thing: Deliver some very simple HTML. Note that we grab the user agent from the Request object instead of the URI we used in the Not_Found handler.

And that is it. I hope that by now it is clear that adding HTTP support to your Ada program is very easy. Of course there's a lot more that can be done with AWS, and I will deal with that in coming articles. For example building the content using strings is rather lame, so in the next article I will turn my attention to using the AWS templating system for the content (Templates_Parser).

Oh and on a final note let me just mention the GPR file for this tutorial program, especially the very first line that says with "aws";. Yes, that is all you need to add to your project file for gnatmake to know that you want it to pull in AWS when compiling your project. It's wonderfully simple. Enjoy!

Ada Programming Community @ Google+

Thomas Løcke — Sat, 08 Dec 2012 15:21:49 +0000

Google just rolled out its latest addition to the Google+ platform: Google+ Communities, and naturally we just had to have an Ada Programming Community.

Hopefully the community will grow at a steady pace and become a good place for general discussion about Ada. We’ve already got two solid posts, one about the state of building Ada programs and another one with a suggestion for a tool that can improve the current situation where many Ada tools heavily depend on GNU make and all sorts of environment variables.

Lively place eh?

If you’re interested in actual software engineering, be sure to join this new community and help make it spring to life.

MediaGoblin, an emerging free and open media publishing platform

Thomas Løcke — Sun, 28 Oct 2012 09:56:54 +0000

I’ve already tried to raise awareness about GNU MediaGoblin at my Google+ stream using the #mediagoblin hashtag and as you can see there is some activity going on. But not enough. I wonder why that is. There’s a lot of open source people hanging out in the Google+ sphere, but judging from the relatively quiet #mediagoblin hashtag, they don’t much care for having a free and open source media publishing platform.

It is rather sad I think.

I’m guessing that most of us fsfe.org people are fully aware of MediaGoblin and their current fundraising campaign, but on the off chance that one of you have missed it completely, here goes: Please go support MediaGoblin. Most of us can easily spare a few $, and if not then at least help spread the word. Lets do our best to make MediaGoblin a new household word. Post about it on Google+, facebook, twitter, identi.ca – wherever you hang out. You might hate social websites such as Google+ like the plague, but understand that they can also be used to spread knowledge about free and open software. It’s not all bad.

Lets do our best to make the #mediagoblin hashtag fly!

Adding support for the ::json datatype to GNATColl

Thomas Løcke — Sun, 28 Oct 2012 09:14:12 +0000

GNATColl is a suite of reusable software components and utilities for the Ada programming language. One of the things that GNATColl can help you accomplish is interfacing with PostgreSQL and SQLite. What it cannot, as per GNATColl 2012, is handle the new ::json datatype added to version 9.2 of PostgreSQL.

This is a bit of a pain for those of us using Ada for web-development, especially those of us relying heavily on JSON. The current solution is to just stick with using the ::text datatype for JSON, and then manage validity in the application, which obviously is annoying given that PostgreSQL now can do all that for you.

So I decided to add ::json support to GNATColl, and as luck would have it, Emmanuel Briot, who appears to be the main contributor to GNATColl, from AdaCore did not oppose the idea. So I got cracking on the patch, and I’m now glad to announce that initial support is up and running, and it is at least working in my own projects. The patch has not been accepted into mainline GNATColl yet, and it wont be for at least another 2-3 weeks, as Emmanuel is on vacation.

The really nice thing about my patch is that it also takes advantage of the fact that GNATColl also handles building JSON objects so why not allow users of the GNATCOLL.SQL utilities to read ::json fields as GNATCOLL.JSON.JSON_Value objects? It looks like this:

type Cursor is new GNATCOLL.SQL.Exec.Forward_Cursor with null record;
 
type Row is
   record
      Some_JSON : GNATCOLL.JSON.JSON_Value;
   end record;
 
function Element
  (C : in Cursor)
   return Row
is
begin
   return Row'(Attr_JSON => C.Json_Object_Value (0));
end Element;
 
A_Row : Row := C.Element;
--  A_Row.Some_JSON is now a JSON_Value object.

Of vourse it is also possible to extract ::json as a string:

type Cursor is new GNATCOLL.SQL.Exec.Forward_Cursor with null record;
 
type Row is
   record
      Some_JSON   : GNATCOLL.JSON.JSON_Value;
      String_JSON : GNATCOLL.JSON.UTF8_String;
   end record;
 
function Element
  (C : in Cursor)
   return Row
is
begin
   return Row'(Some_JSON   => C.Json_Object_Value (0),
               String_JSON => C.Json_String_value (0));
end Element;
 
A_Row : Row := C.Element;
--  A_Row.Some_JSON is now a JSON_Value object.
--  A_Row.String_JSON is now an UTF8_String.

Currently my patch only support writing UTF8_String JSON to the database, but I’d really like to have support for writing JSON_Value objects directly, but I’m not sure what Emmanuel will think about that idea. Time will tell I guess. I can see no reasons for not adding this, as users of the GNATCOLL.SQL interface also have GNATCOLL.JSON readily available, so no additional dependencies are being added to burden users. If you want to try this yourself, grab the latest SVN of GNATColl and my patched version:

svn co http://svn.eu.adacore.com/anonsvn/Dev/trunk/gps/gnatlib/
git clone git://github.com/ThomasLocke/GNATColl.git

You’ll have to do some manual mucking about with copying files from my version to the official version to make it work. The files you need to copy are these:

src/postgres/with_postgres/gnatcoll-sql-postgres-builder.adb
src/sqlite/with_sqlite/gnatcoll-sql-sqlite-builder.adb
src/tools/gnatcoll_db2ada.adb
src/dborm.py
src/gnatcoll-sql-exec.adb
src/gnatcoll-sql-exec.ads
src/gnatcoll-sql-exec_private.adb
src/gnatcoll-sql-exec_private.ads
src/gnatcoll-sql-inspect.adb
src/gnatcoll-sql-inspect.ads
src/gnatcoll-sql.ads
src/gnatcoll-sql_impl.adb
src/gnatcoll-sql_impl.ads

Note that the addition to dborm.py does not enable the JSON_Value stuff. For some odd reason the ORM stuff doesn’t work very well on my box (I get a bunch of Python and gnatchop errors), and since I don’t use ORM I didn’t spend an inordinate amount of time getting it fixed. If Emmanuel approves my patch, the ORM stuff will of course also be fixed.

“Hello World” GtkAda and Glade3 Tutorial

Thomas Løcke — Thu, 20 Sep 2012 07:12:44 +0000

Many years ago I tried my hand at Glade and PHP-Gtk (don’t ask!), and I found the entire experience to be fairly horrible. Since then I’ve steered well clear of anything to do with Gtk – in fact I’ve steered clear of GUI (Gtk/Qt) programming in general, mostly because I’ve found that if a program I’m building needs a GUI, it is usually much easier to just deploy it in the browser using HTML/CSS/Javascript (Argh! I really detest Javascript – thank God for the Dart project).

Well, that was then, and this is now.

Today I noticed that a new article had been added to the Ada-DK Wiki: Building GUI With Glade3. Naturally the short tutorial make use of Ada and GtkAda, so it’s right up my alley.

It looks absolutely doable. The code is clean and simple, and not at all as messy as my PHP-Gtk experiments those many years ago. Maybe it is time for me to give GtkAda and Glade3 a try?

Yolk aligned with latest Ada Web Server update

Thomas Løcke — Thu, 06 Sep 2012 10:38:20 +0000

When I got back from my trip to Iceland, I did a git pull on AWS and among the ~89 patches that had gone in since my departure from Denmark, a handful added some new configuration parameters. I’ve added these new parameters to Yolk, so it now requires AWS commit 30281b522ed43782c8f9e7fd1f0fd912510b48f0 in order to work. It is no longer enough to just grab the latest official AWS package from libre.adacore.com – you must use the developer version of AWS.

Labeled exit bug in GNAT GPL 2012 confirmed

Thomas Løcke — Tue, 17 Jul 2012 07:10:00 +0000

While trying out the new Ada 2012 loop syntax, I discovered what appeared to be a bug in the compiler: I could not use labeled exit statements when using the new loop syntax. Observe this simple example:

with Ada.Text_IO;
 
procedure Loopy is
   use Ada.Text_IO;
 
   Foo : array (1 .. 3) of String (1 .. 3)
     := (2 => "Bar", others => "Foo");
begin
   --  Classic loop syntax
   for I in Foo'Range loop
      Put_Line (Foo (I));
   end loop;
 
   --  New loop syntax
   for K of Foo loop
      Put_Line (K);
   end loop;
end Loopy;

Compiling this with the -gnat2012 works like a charm and output from the program is as expected:

Foo
Bar
Foo
Foo
Bar
Foo

Obviously using labeled loops/exits in this example is more or less completely pointless, but since I’m a bit of a renegade (and for the sake of the argument), I’m going to do it anyway. Lets see what happens:

with Ada.Text_IO;
 
procedure Loopy is
   use Ada.Text_IO;
 
   Foo : array (1 .. 3) of String (1 .. 3)
     := (2 => "Bar", others => "Foo");
begin
   --  Classic loop syntax
   Loop_Classic : for I in Foo'Range loop
      exit Loop_Classic When Foo (I) = "Bar";	  
      Put_Line (Foo (I));
   end loop Loop_Classic;
 
   --  New loop syntax
   Loop_New : for K of Foo loop
      exit Loop_New when K = "Bar";    
      Put_Line (K);
   end loop Loop_New;
end Loopy;

Awesome labels I’ve come up with eh’?

Compiling the above example yields this little puppy:

gcc -c -gnat2012 loopy.adb
loopy.adb:17:07: invalid loop name in exit statement
gnatmake: "loopy.adb" compilation error

Gaagle! The horror! The pain! The bug has been reported to AdaCore by Marc A. Criley, and according to this notice they’ve sorta/kinda acknowledged it.

So all we have to do now is wait for a fix. When I cried out on comp.lang.ada that I wanted my labeled exit statements back, he replied with this:

GNAT GPL 2013

Hehe.. Dry fellow that Marc. But he’s probably right. I’m just going to have to patiently wait an entire year before I can actually use the new loop syntax and labeled exit statements at the same time. I can handle that. I think.

Eating Pez With Ada

Thomas Løcke — Mon, 16 Jul 2012 14:23:05 +0000

Back in May I wrote an article called Concurrent Ada Programming. It was meant as an introduction to the wonderful world of Ada tasking and protected objects, and while the code presented in the article most certainly did not muck about with complex constructions and mind-bending designs, it did however expose the reader to my rather feeble attempts at naming identifiers, as Georg Bauhaus was kind enough to point out to me:

Can I make some comments about the choice of identifiers? That’s from the perspective of a reader, totally subjective, of course. It reflects what had me a little confused at first, looking at the source (not the explanation). For example, there are: Jobs (Positive), Job (Natural), Jobs (protected), A_Job (Natural), Job as an immutable loop variable. And none of these is, well, if I may, a job (task). They are jobs’ numbers, though, as the output indicates.

This might all appear nitpicky, I guess. I always found good names helpful for understanding source from source, which is why…

Of course Georg is completely right, and because it did not appear nit-picky to me at all, I decided to code a completely new example, this time focusing on the beloved Pez dispenser. One Pez dispenser + several children = perfect situation to flex a bit of Ada tasking muscle. I’ve tried my best to name the identifiers properly, and I do believe I’ve done a marginally better job of it than in my previous article.

So without further ado, lets get on with the Ada programming, and check out a basic sequential Pez dispenser example (one child, one dispenser). Note that the example make use of an Ada 2012 feature, so you must have an Ada 2012 compiler to make it work. I’ve used the GNAT GPL 2012 compiler.

Before you read on, please clone the Pez_Dispenser project from my github account, so you have all the files available.

with Ada.Task_Identification;
with Ada.Text_IO;
 
procedure Sequential is
 
   use Ada.Task_Identification;
   use Ada.Text_IO;
 
   Task_Id : constant String := Image (Current_Task);
 
   type Reward is (Candy, No_Candy);
 
   type Dispenser is
      record
         Available_Candies : Natural := 20;
      end record;
 
   function Pop
     (D : in out Dispenser)
   return Reward;
   --  Get one of those delicious candies!
 
   -----------
   --  Pop  --
   -----------
 
   function Pop
     (D : in out Dispenser)
     return Reward
   is
   begin
      case D.Available_Candies is
         when 0 =>
            return No_Candy;
         when others =>
            D.Available_Candies := D.Available_Candies - 1;
            Put_Line (Task_Id & " pops a candy from the dispenser.");
            Put_Line (Natural'Image (D.Available_Candies) 
                      & " left in the dispenser");
            return Candy;
      end case;
   end Pop;
 
   Result        : Reward;
   Pez_Dispenser : Dispenser;
 
begin
 
   A_Child_Popping_Pez : loop
      Result := Pop (Pez_Dispenser);
 
      exit A_Child_Popping_Pez when Result = No_Candy;
 
      delay 1.0; 
      --  This simulates chewing. Yes, a 1 second chew is pretty darn fast!
   end loop A_Child_Popping_Pez;
 
   Put_Line ("No more candy! " & Task_Id & " runs out to play.");
 
end Sequential;

Looks nice eh? I am hopeful that it reads better than the example from my previous article, and if it doesn’t, well then I think I’ll just give up on this subject.

But for now lets assume that the example code is good, and do a quick rundown of what is going on.

The Ada.Task_Identification package makes it possible for us to figure out the id of a task and Ada.Text_IO makes the Put_Line procedure available to Sequential.

The use clauses we encounter next lets us access the tools of the Ada.Text_IO and Ada.Task_Identification packages without having to prefix every type and subprogram with the package name. This is equivalent to the using namespace statement in C++. Note that it is fairly easy to abuse use clauses to a point where your code becomes almost unreadable. Another option is using renames instead, for example like this:

with Ada.Text_IO;
 
procedure Foo is
   package IO renames Ada.Text_IO;
begin
   IO.Put_Line ("Hey!");
end Foo;

But I digress. Lets get back on track!

Next up we declare and initialize the Task_Id constant. This is basically just a string representation of the internal id for the main environment task. Both Image and Current_Task are methods found in the Ada.Task_Identification package. We use the Task_Id constant to identify the task that is currently chewing on a snack.

After the Task_Id declaration, we define the new type Reward as an enumeration type with the possible values Candy and No_Candy. The Dispenser type is a record with a single component, Available_Candies, which is initialized with the value 20, meaning that all new dispensers comes loaded with 20 delicious candies. Not too shabby!

The Pop function takes a Dispenser and returns a Reward. If there are still candies in the dispenser, then it decreases the number of available candies by 1. Note that it is the D : in out Dispenser parameter in this function that requires an Ada 2012 compiler. Older versions of Ada only allow in parameters when using functions.

Finally we declare the Result variable as a Reward and the Pez_Dispenser variable as a Dispenser.

And that my friends was all the declaration stuff (the part between is and begin). Next up: The body of the program (the part between begin and end).

The meat of the body is the A_Child_Popping_Pez loop, in which the first thing we do is call the Pop function with our Pez_Dispenser and put the reward in the Result variable. After that we exit the loop if the reward given in Result is No_Candy. If the given reward is Candy we proceed with some chewing in the form of the delay 1.0 statement. This proceeds until all the candies are gone and the dispenser is empty.

When the loop exits we cheerfully let the world know that because there are no more candies, we might as well run out to play.

Let us compile and run the program:

$ cd sequential
$ gnatmake -P sequential.gpr
$ time sequential

You should now see something like this flow by:

thomas@t420:~/Ada/Pez_Dispenser/sequential$ time sequential
main_task_000000000064C010 pops a candy from the dispenser.
 19 left in the dispenser
main_task_000000000064C010 is chewing on a candy.
main_task_000000000064C010 pops a candy from the dispenser.
 18 left in the dispenser
main_task_000000000064C010 is chewing on a candy.
main_task_000000000064C010 pops a candy from the dispenser.
 17 left in the dispenser
main_task_000000000064C010 is chewing on a candy.
main_task_000000000064C010 pops a candy from the dispenser.
 16 left in the dispenser
main_task_000000000064C010 is chewing on a candy.
main_task_000000000064C010 pops a candy from the dispenser.
 15 left in the dispenser
main_task_000000000064C010 is chewing on a candy.
main_task_000000000064C010 pops a candy from the dispenser.
 14 left in the dispenser
main_task_000000000064C010 is chewing on a candy.
main_task_000000000064C010 pops a candy from the dispenser.
 13 left in the dispenser
main_task_000000000064C010 is chewing on a candy.
main_task_000000000064C010 pops a candy from the dispenser.
 12 left in the dispenser
main_task_000000000064C010 is chewing on a candy.
main_task_000000000064C010 pops a candy from the dispenser.
 11 left in the dispenser
main_task_000000000064C010 is chewing on a candy.
main_task_000000000064C010 pops a candy from the dispenser.
 10 left in the dispenser
main_task_000000000064C010 is chewing on a candy.
main_task_000000000064C010 pops a candy from the dispenser.
 9 left in the dispenser
main_task_000000000064C010 is chewing on a candy.
main_task_000000000064C010 pops a candy from the dispenser.
 8 left in the dispenser
main_task_000000000064C010 is chewing on a candy.
main_task_000000000064C010 pops a candy from the dispenser.
 7 left in the dispenser
main_task_000000000064C010 is chewing on a candy.
main_task_000000000064C010 pops a candy from the dispenser.
 6 left in the dispenser
main_task_000000000064C010 is chewing on a candy.
main_task_000000000064C010 pops a candy from the dispenser.
 5 left in the dispenser
main_task_000000000064C010 is chewing on a candy.
main_task_000000000064C010 pops a candy from the dispenser.
 4 left in the dispenser
main_task_000000000064C010 is chewing on a candy.
main_task_000000000064C010 pops a candy from the dispenser.
 3 left in the dispenser
main_task_000000000064C010 is chewing on a candy.
main_task_000000000064C010 pops a candy from the dispenser.
 2 left in the dispenser
main_task_000000000064C010 is chewing on a candy.
main_task_000000000064C010 pops a candy from the dispenser.
 1 left in the dispenser
main_task_000000000064C010 is chewing on a candy.
main_task_000000000064C010 pops a candy from the dispenser.
 0 left in the dispenser
main_task_000000000064C010 is chewing on a candy.
No more candy! main_task_000000000064C010 runs out to play.

real    0m20.004s
user    0m0.000s
sys     0m0.002s

As you can see it takes the main_task_000000000064C010 (you might get a different name on your system) child 20 seconds to chew its way through all the candies in the Pez dispenser.

We can make this go “faster” by adding some more children and have them share the dispenser. Lets see how we can do that using tasks and a protected object.

with Ada.Task_Identification;
with Ada.Text_IO;
 
procedure Concurrent is
 
   use Ada.Task_Identification;
   use Ada.Text_IO;
 
   type Reward is (Candy, No_Candy);
 
   protected Pez_Dispenser is
      procedure Pop
        (Result  : out Reward;
         Task_Id : in  String);
      --  Get one of those delicious candies!
   private
      Available_Candies : Natural := 20;
   end Pez_Dispenser;
 
   ---------------------
   --  Pez_Dispenser  --
   ---------------------
 
   protected body Pez_Dispenser is
      -----------
      --  Pop  --
      -----------
 
      procedure Pop
        (Result  : out Reward;
         Task_Id : in  String)
      is
      begin
         case Available_Candies is
            when 0 =>
               Result := No_Candy;
            when others =>
               Result := Candy;
 
               Available_Candies := Available_Candies - 1;
 
               Put_Line (Task_Id & " pops a candy from the dispenser.");
               Put_Line (Natural'Image (Available_Candies) 
                         & " left in the dispenser");
         end case;
      end Pop;
   end Pez_Dispenser;
 
   task type Child;
   --  A Child wants candy, and when the child gets a candy it spends time
   --  chewing it. If there's no more candy, the child exits the "pop" loop
   --  and goes out to play in the garden.
 
   --------------
   --  Child  --
   --------------
 
   task body Child 
   is
      Task_Id : constant String := Image (Current_Task);
      Result  : Reward;
   begin
      A_Child_Popping_Pez : loop
         Pez_Dispenser.Pop (Result, Task_Id);
 
         exit A_Child_Popping_Pez when Result = No_Candy;
 
         delay 1.0; 
      --  This simulates chewing. Yes, a 1 second chew is pretty darn fast!
      end loop A_Child_Popping_Pez;
 
      Put_Line ("No more candy! " & Task_Id & " runs out to play.");
   end Child;
 
   Alice  : Child;
   Bob    : Child;
   Clair  : Child;
   Dwayne : Child;
 
begin
 
   null;  --  We're not using the main environment task for anything.
 
end Concurrent;

Not too complicated I should say. We with and use the same packages as before, but after that there are a few new things, first of which is a protected object. In Ada these are objects that export procedures, functions and entries that enables us to interact with the encapsulated data structure. In our case we’ve set up a protected object called Pez_Dispenser (effectively a singleton), but we could just as well have created a protected type and then declared one of more objects to be of that type, as we did with the Dispenser type in the sequential example.

We can only operate on the data structure of a protected object via the exported subprograms and this is done under automatic mutual exclusion. A protected object will allow many concurrent readers (via exported functions), but only one writer (via exported procedures and entries).

A protected object is just what we need to protect our Pez dispenser from race conditions (raging kids all grabbing for the same candy!), now that we have several tasks (children) querying and updating it.

Lets take a closer look at the code:

protected Pez_Dispenser is
   procedure Pop
     (Result  : out Reward;
      Task_Id : in  String);
   --  Get one of those delicious candies!
private
   Available_Candies : Natural := 20;
end Pez_Dispenser;
 
---------------------
--  Pez_Dispenser  --
---------------------
 
protected body Pez_Dispenser is
   -----------
   --  Pop  --
   -----------
 
   procedure Pop
     (Result  : out Reward;
      Task_Id : in  String)
   is
   begin
      case Available_Candies is
         when 0 =>
            Result := No_Candy;
         when others =>
            Result := Candy;
 
            Available_Candies := Available_Candies - 1;
 
            Put_Line (Task_Id & " pops a candy from the dispenser.");
            Put_Line (Natural'Image (Available_Candies) 
                      & " left in the dispenser");
      end case;
   end Pop;
end Pez_Dispenser;

First we declare our Pez_Dispenser protected object where we export the sole Pop procedure, which is the only way for us to interact with the very simple data structure consisting only of the variable Available_Candies.

In the body of Pez_Dispenser we find the actual implementation of the Pop procedure. If Available_Candies is greater than 0 then Result is set to Candy, Available_Candies is reduced by 1 and a short message about who did the popping and how many candies are left in the dispenser is written to STDOUT. If Available_Candies is 0 then Result is set to No_Candy.

With this simple system in place we’re ensured that access to Available_Candies is only ever granted to one single task (child) at a time. As soon as one task is done popping a Pez, access is opened up to the next task.

With a secure Pez_Dispenser in place we move on to creating the tasks that will be doing the actual eating:

task type Child;
--  A Child wants candy, and when the child gets a candy it spends time
--  chewing it. If there's no more candy, the child exits the "pop" loop
--  and goes out to play in the garden.
 
--------------
--  Child  --
--------------
 
task body Child 
is
   Task_Id : constant String := Image (Current_Task);
   Result  : Reward;
begin
   A_Child_Popping_Pez : loop
      Pez_Dispenser.Pop (Result, Task_Id);
 
      exit A_Child_Popping_Pez when Result = No_Candy;
 
      delay 1.0; 
      --  This simulates chewing. Yes, a 1 second chew is pretty darn fast!
   end loop A_Child_Popping_Pez;
 
   Put_Line ("No more candy! " & Task_Id & " runs out to play.");
end Child;

First we declare a task type called Child. We could’ve setup a task object, just as we did with the Pez_Dispenser protected object, but since we want more than one Child a type is the way to go. The body of the task looks a lot like the body from the Sequential program.

Inside the Child task we declare the Task_Id constant so we can identify each of the running Child tasks, and then we declare the Result variable to be of the type Reward.

In the body of the Child task we’ve got a plain named loop in which the first thing we do is try and pop a candy from the Pez_Dispenser. If Result equals No_Candy after having called Pop we immediately exit the loop and output the sad “No more candy!” message. If Result is Candy we Chew to our hearts content, again signified by the delay 1.0 statement.

Last we have this:

   Alice  : Child;
   Bob    : Child;
   Clair  : Child;
   Dwayne : Child;
 
begin
 
   null;  --  We're not using the main environment task for anything.
 
end Concurrent;

Here we declare the children Alice, Bob, Clair and Dwayne. As soon as the program reaches this spot, four Child tasks are created and when we pass begin they spring to life. Since we already have 4 children trying to get to the candy like there’s no tomorrow, we don’t really need to add any code to the main environment task, so we simply provide a null statement. The main environment task is the master of the 4 Child tasks, so it wont complete until all 4 Child tasks have completed.

Lets compile and see how the program performs now:

$ cd concurrent
$ gnatmake -P sequential.gpr
$ time sequential

thomas@t420:~/Ada/Pez_Dispenser/concurrent$ time concurrent
bob_000000000065D2C0 pops a candy from the dispenser.
 19 left in the dispenser
bob_000000000065D2C0 is chewing on a candy.
dwayne_0000000000663D80 pops a candy from the dispenser.
 18 left in the dispenser
dwayne_0000000000663D80 is chewing on a candy.
alice_0000000000659D60 pops a candy from the dispenser.
 17 left in the dispenser
alice_0000000000659D60 is chewing on a candy.
clair_0000000000660820 pops a candy from the dispenser.
 16 left in the dispenser
clair_0000000000660820 is chewing on a candy.
bob_000000000065D2C0 pops a candy from the dispenser.
 15 left in the dispenser
bob_000000000065D2C0 is chewing on a candy.
alice_0000000000659D60 pops a candy from the dispenser.
 14 left in the dispenser
alice_0000000000659D60 is chewing on a candy.
dwayne_0000000000663D80 pops a candy from the dispenser.
 13 left in the dispenser
dwayne_0000000000663D80 is chewing on a candy.
clair_0000000000660820 pops a candy from the dispenser.
 12 left in the dispenser
clair_0000000000660820 is chewing on a candy.
bob_000000000065D2C0 pops a candy from the dispenser.
 11 left in the dispenser
bob_000000000065D2C0 is chewing on a candy.
alice_0000000000659D60 pops a candy from the dispenser.
 10 left in the dispenser
alice_0000000000659D60 is chewing on a candy.
dwayne_0000000000663D80 pops a candy from the dispenser.
 9 left in the dispenser
dwayne_0000000000663D80 is chewing on a candy.
clair_0000000000660820 pops a candy from the dispenser.
 8 left in the dispenser
clair_0000000000660820 is chewing on a candy.
bob_000000000065D2C0 pops a candy from the dispenser.
 7 left in the dispenser
bob_000000000065D2C0 is chewing on a candy.
alice_0000000000659D60 pops a candy from the dispenser.
 6 left in the dispenser
alice_0000000000659D60 is chewing on a candy.
dwayne_0000000000663D80 pops a candy from the dispenser.
 5 left in the dispenser
dwayne_0000000000663D80 is chewing on a candy.
clair_0000000000660820 pops a candy from the dispenser.
 4 left in the dispenser
clair_0000000000660820 is chewing on a candy.
bob_000000000065D2C0 pops a candy from the dispenser.
 3 left in the dispenser
bob_000000000065D2C0 is chewing on a candy.
alice_0000000000659D60 pops a candy from the dispenser.
 2 left in the dispenser
alice_0000000000659D60 is chewing on a candy.
dwayne_0000000000663D80 pops a candy from the dispenser.
 1 left in the dispenser
dwayne_0000000000663D80 is chewing on a candy.
clair_0000000000660820 pops a candy from the dispenser.
 0 left in the dispenser
clair_0000000000660820 is chewing on a candy.
No more candy! bob_000000000065D2C0 runs out to play.
No more candy! alice_0000000000659D60 runs out to play.
No more candy! dwayne_0000000000663D80 runs out to play.
No more candy! clair_0000000000660820 runs out to play.

real    0m5.012s
user    0m0.002s
sys     0m0.001s

There you have it. With 4 children attacking our Pez dispenser it takes a mere 5 seconds to empty it. Obviously the performance gains are normally not as linear as in this simple example where chewing each candy amounts to no more than a simple delay 1.0 statement. The performance gained from adding concurrency to a program depends on a lot of different factors.

The important point to get across is that adding concurrency to a program doesn’t have to be complicated. Adding concurrency to an Ada program is very simple, and the model for doing it is easy, both to understand and to work with. When you’re using Ada there’s simply no excuse for not adding concurrency to your program where it will benefit from it.

There is of course a whole lot more to Ada and concurrent programming than shown here. This little example has barely scratched the surface. A good place to start is the Ada Programming Wikibook.

You can grab the code for these examples at github.com/ThomasLocke/Pez_Dispenser.

Finally a big thank you goes out to my good friend Dwight Scott Miller for helping me weed out the worst parts of my Danish-ified English. I really appreciate it.

Concurrent Ada Programming

Thomas Løcke — Thu, 17 May 2012 13:36:32 +0000

Ada’s model for doing concurrent programming is absolutely marvelous, and today I’m going to give you a small taste of it. More or less all programming languages provide tools for concurrent programming, but few do it as elegant as Ada, where the whole concept has been build into the language from it’s inception in 1983.

In Ada concurrent programming is a first class citizen, not an afterthought, and in this day and age where even the cheapest of processors have multiple cores, being able to properly harness the power of those many cores is important. A lot of programs could benefit from a bit of concurrent magic, but since concurrent programming brings with it a whole new set of problems, many programmers shy away from it. Not so with Ada programmers. We have tasks, protected objects, scheduling, guards and entries right there in front of us. In this article I’m going to show you how tasks and protected objects can be used to add concurrency to a very simple program.

The first thing we’re going to do is setup a small program that solves the plain problem of counting 20 times to 1_000_000_000.

One possible Ada solution to this problem is this:

with Ada.Task_Identification;
with Ada.Text_IO;
 
procedure Sequential
is
   use Ada.Task_Identification;
   use Ada.Text_IO;
 
   Id   : constant String := Image (Current_Task);
   Jobs : Positive := 20;
begin
   for Job in reverse 1 .. Jobs loop
      for K in 1 .. 1_000_000_000 loop
	 null; --  This is really hard!
      end loop;
 
      Put_Line ("Job" & Positive'Image (Job) & " done by " & Id);
   end loop;
end Sequential;

Before we get into actually compiling and running Sequential, allow me to first explain what’s going on in the program.

First we with the two packages Ada.Task_Identification and Ada.Text_IO. What this does is make the subprograms and types from those packages visible and available to our program, somewhat analogous to the #include directive used in C. After that we setup our “main” procedure and name it Sequential. In Ada you can call your main procedure whatever you like. The use clauses we encounter next lets us access the tools of the Ada.Text_IO and Ada.Task_Identification packages without having to prefix every type and subprogram with the package name. This is equivalent to the using namespace statement in C++.

The Ada.Task_Identification package makes it possible for us to figure out the id of a running task and Ada.Text_IO makes the Put_Line procedure available to Sequential.

We declare and initialize two objects in the declarative part of the program (between is and begin): Id and Jobs. The Id constant contains a String representation of the environment task identifier. As our program only have one running task (or thread if you will), which is the main environment task, the output done in the Put_Line line will show the same Id for every job completed.

The Jobs variable is the queue of jobs, in our case 20. Note that the Positive type is actually a subtype of Integer with the range 1 .. Integer'Last. If you try to assign a value below 1 or above Integer'Last then the program will raise a Constraint_Error exception.

After the begin keyword we’re in the actual body of the program, and the first thing we do is setup a for loop that’ll count down from 20 to 1, as indicated by the reverse keyword and the given range of 1 .. Jobs.

Inside this loop we do the actual work: Counting to 1_000_000_000 for each job and then outputting a line of text indicating whenever a job has been completed and by which task id.

And that’s it.

In order to compile the program do:

gnatmake sequential.adb

And then to execute and time:

time sequential

My laptop yields the following when executed and timed:

thomas@t420:~/Ada/Simple_Tasking time sequential
Job 20 done by main_task_000000000064A010
Job 19 done by main_task_000000000064A010
Job 18 done by main_task_000000000064A010
Job 17 done by main_task_000000000064A010
Job 16 done by main_task_000000000064A010
Job 15 done by main_task_000000000064A010
Job 14 done by main_task_000000000064A010
Job 13 done by main_task_000000000064A010
Job 12 done by main_task_000000000064A010
Job 11 done by main_task_000000000064A010
Job 10 done by main_task_000000000064A010
Job 9 done by main_task_000000000064A010
Job 8 done by main_task_000000000064A010
Job 7 done by main_task_000000000064A010
Job 6 done by main_task_000000000064A010
Job 5 done by main_task_000000000064A010
Job 4 done by main_task_000000000064A010
Job 3 done by main_task_000000000064A010
Job 2 done by main_task_000000000064A010
Job 1 done by main_task_000000000064A010

real    0m52.737s
user    0m52.636s
sys     0m0.001s

As you can see it took a good 52 seconds to finish all 20 jobs. At no point during the execution of the program did the system utilize more than one CPU core. Each job was completed in an absolute sequential manner, starting with job 20 and ending with 1.

Surely this is sad, considering my laptop is equipped with a CPU sporting a whooping four cores. Lets add some tasking magic to the program and see how much faster we can make it go.

with Ada.Task_Identification;
With Ada.Text_IO;
 
procedure Concurrent
is
   use Ada.Task_Identification;
   use Ada.Text_IO;
 
   protected Jobs is
      procedure Get 
	(Job : out Natural);
   private
      J : Natural := 20;
   end Jobs;
 
   ------------
   --  Jobs  --
   ------------
 
   protected body Jobs is
      -----------
      --  Get  --
      -----------
 
      procedure Get 
	(Job : out Natural)
      is
      begin
	 Job := J;
         if J > 0 then
            J := J - 1;
         end if;
      end Get;
   end Jobs;
 
   task type Worker;
   --  The Worker gets a job, and does the hard work.
   --  When there are no more jobs, the Worker exits.
 
   --------------
   --  Worker  --
   --------------
 
   task body Worker is
      A_Job : Natural;
      Id    : constant String := Image (Current_Task);
   begin
      loop
	 Jobs.Get (A_Job);
 
	 exit when A_Job < 1; 
 
	 for K in 1 .. 1_000_000_000 loop
	    null; --  This is really hard!
	 end loop;
 
	 Put_Line ("Job" & Natural'Image (A_Job) & " done by " & Id);
      end loop;
   end Worker;
 
   Workers : array (1 .. 4) of Worker;
begin
   null; --  We're not using the main environment task for anything.
end Concurrent;

Let’s dive in!

We with and use the same packages as before, but after that there are quite a few new things, first of which is a protected object. In Ada these are objects that export procedures, functions and entries that enables us to interact with the encapsulated data structure. In our case we’ve setup a protected object called Jobs, but we could just as well have created a protected type and then declared one of more objects to be of that type.

A protected object is just what we need to protect our job queue from race conditions, now that we have several tasks querying and updating it.

   protected Jobs is
      procedure Get 
	(Job : out Natural);
   private
      J : Natural := 20;
   end Jobs;
 
   ------------
   --  Jobs  --
   ------------
 
   protected body Jobs is
      -----------
      --  Get  --
      -----------
 
      procedure Get 
	(Job : out Natural)
      is
      begin
	 Job := J;
         if J > 0 then
            J := J - 1;
         end if;
      end Get;
   end Jobs;

First we declare our Jobs protected object. We export the sole Get (Job : out Natural) procedure, which is the only way for us to interact with the very simple data structure, consisting only of the variable J.

In the body of Jobs we find the actual implementation of the Get procedure. All it does is put the current value of J into the Job parameter and then decrease the value of J by one. With this simple system in place we’re ensured that access to J is only ever granted to one single task at the same time. Only when that task is done is the next one allowed access.

With a secure job queue in place we move on to creating the tasks that will be doing the actual work:

   task type Worker;
   --  The Worker gets a job, and does the hard work.
   --  When there are no more jobs, the Worker exits.
 
   --------------
   --  Worker  --
   --------------
 
   task body Worker is
      A_Job : Natural;
      Id    : constant String := Image (Current_Task);
   begin
      loop
	 Jobs.Get (A_Job);
 
	 exit when A_Job < 1; 
 
	 for K in 1 .. 1_000_000_000 loop
	    null; --  This is really hard!
	 end loop;
 
	 Put_Line ("Job" & Natural'Image (A_Job) & " done by " & Id);
      end loop;
   end Worker;

First we declare a task type called Worker. We could’ve setup a task object, just as we did with the Jobs protected object, but since we want more than one worker a type is the way to go. The body of the task looks a lot like the body from the Sequential program, with a few minor differences. We declare the A_Job variable to be of the type Natural, which is a subtype of Integer with the range 0 .. Integer'Last. The Id constant is exactly like the one from the first program.

In the body of the Worker task we’ve got a plain loop that starts out with putting a job into the A_Job variable. We then check if the job is valid in the exit when... line and if not we exit the loop and the task is then completed.

The for loop and the Put_Line code is more or less the same as before.

Last we have this:

   Workers : array (1 .. 4) of Worker;
begin
   null; --  We're not using the main environment task for anything.
end Concurrent;

Here we declare an array of 4 Worker tasks. As soon as the program reach this spot, four workers are created and when we pass begin they spring to life. Since we already have 4 workers counting to 1_000_000_000 like there’s no tomorrow, we don’t really need to add any code to the main environment task, so we simply add a null statement. The main environment task is the master of the 4 workers, so it wont complete until all 4 workers have completed.

Lets see how the program performs now:

thomas@t420:~/Ada/Simple_Tasking$ time concurrent
Job 20 done by workers(4)_000000000065FCC0
Job 19 done by workers(2)_0000000000659240
Job 18 done by workers(3)_000000000065C780
Job 17 done by workers(1)_0000000000655D00
Job 16 done by workers(4)_000000000065FCC0
Job 15 done by workers(2)_0000000000659240
Job 13 done by workers(1)_0000000000655D00
Job 14 done by workers(3)_000000000065C780
Job 12 done by workers(4)_000000000065FCC0
Job 10 done by workers(1)_0000000000655D00
Job 11 done by workers(2)_0000000000659240
Job 9 done by workers(3)_000000000065C780
Job 6 done by workers(2)_0000000000659240
Job 8 done by workers(4)_000000000065FCC0
Job 7 done by workers(1)_0000000000655D00
Job 5 done by workers(3)_000000000065C780
Job 4 done by workers(2)_0000000000659240
Job 3 done by workers(4)_000000000065FCC0
Job 1 done by workers(3)_000000000065C780
Job 2 done by workers(1)_0000000000655D00

real    0m18.727s
user    1m11.454s
sys     0m0.025s

YAY! It is much faster now, and all four cores on my CPU is running at 100% while the program executes. Also note how the jobs are no longer completed sequentially. You can experiment with the amount of workers by changing the size of the Workers array. On my box the sweet spot is firing up 20 workers at the same time. With twenty workers I’m very close to a clean 18 seconds. The second fastes result is obtained with 4 workers. Every other amount of workers I’ve tried is slower.

There’s of course a whole lot more to Ada and concurrent programming than shown here. This little example has barely scratched the surface. A good place to start is the Ada Programming Wikibook.

You can grab the code for these examples at github.com/ThomasLocke/Simple_Tasking.

Adding concurrency to an Ada program is very simple, and the model for doing it is both easy to understand and to work with. When you’re using Ada there’s simply no excuse for not adding concurrency to your program where it will benefit from it.