❌ About FreshRSS

Reading view

There are new articles available, click to refresh the page.

Ada vs C++ Bit-fields

Uses of Bit-fields
Bit-fields are typically used to implement communication protocols and to create device drivers for actuators or sensors. Frequently the actuators or sensors will use A/D and D/A converters to associate specific bit groupings with analog voltages on device connector pins.
In safety critical systems the bit patterns of the bit-fields must be correctly arranged or communication with the actuator or sensor will be incorrect. Since many safety critical systems require command of actuators, combined with resulting sensor readings to provide a closed loop control system, the ability to correctly define the bit layout for each device interface is highly safety critical.

JSF C++ Coding Standard

AV Rule 154 (MISRA Rules 111 and 112, Revised)

Bit-fields shall have explicitly unsigned integral or enumeration types only.



Rationale: Whether a plain (neither explicitly signed nor unsigned) char, short, int or long bit-field is signed or unsigned is implementation-defined.[10] Thus, explicitly declaring a bit-filed unsigned prevents unexpected sign extension or overflow.
Note: MISRA Rule 112 no longer applies since it discusses a two-bit minimum-length requirement for bit-fields of signed types.

AV Rule 155

Bit-fields will not be used to pack data into a word for the sole purpose of saving space.
Note: Bit-packing should be reserved for use in interfacing to hardware or conformance to communication protocols.
Warning: Certain aspects of bit-field manipulation are implementation-defined.


Rationale: Bit-packing adds additional complexity to the source code. Moreover, bit-packing may not save any space at all since the reduction in data size achieved through packing is often offset by the increase in the number of instructions required to pack/unpack the data.

AV Rule 156  (MISRA Rule 113)

All the members of a structure (or class) shall be named and shall only be accessed via their names.

Rationale: Reading/writing to unnamed locations in memory is error prone.
Exception: An unnamed bit-field of width zero may be used to specify alignment of the next bit-field at an allocation boundary. [10], 9.6(2)



C++ Bit-fields Explained

The following explanation of C++ bit-fields is taken from http://en.cppreference.com/w/cpp/language/bit_field

Bit field

Declares a class data member with explicit size, in bits. Adjacent bit field members may be packed to share and straddle the individual bytes.
A bit field declaration is a class data member declaration which uses the following declarator:
identifier(optional)attr(optional) : size
(1)
The type of the bit field is introduced by the decl-specifier-seq of the declaration syntax.
attr(C++11)
-
optional sequence of any number of attributes
identifier
-
the name of the bit field that is being declared. The name is optional: nameless bitfields introduce the specified number of bits of padding
size
-
an integral constant expression with a value greater or equal to zero. When greater than zero, this is the number of bits that this bit field will occupy. The value zero is only allowed for nameless bitfields and has special meaning: it specifies that the next bit field in the class definition will begin at an allocation unit's boundary.

Explanation

The number of bits in a bit field sets the limit to the range of values it can hold:
#include <iostream>
struct S {
// three-bit unsigned field,
// allowed values are 0...7

};
int main()
{
S s
s.b
std::cout << s.b << '\n'; // output: 0
}
Multiple adjacent bit fields are usually packed together (although this behavior is implementation-defined):
#include <iostream>
struct S {
// will usually occupy 2 bytes:
// 3 bits: value of b1
// 2 bits: unused
// 6 bits: value of b2
// 2 bits: value of b3
// 3 bits: unused

};
int main()
{
std::cout << sizeof(S) << '\n'; // usually prints 2
}
The special unnamed bit field of size zero can be forced to break up padding. It specifies that the next bit field begins at the beginning of its allocation unit:
#include <iostream>
struct S {
// will usually occupy 2 bytes:
// 3 bits: value of b1
// 5 bits: unused
// 6 bits: value of b2
// 2 bits: value of b3




};
int main()
{
std::cout << sizeof(S) << '\n'; // usually prints 2
}
If the specified size of the bit field is greater than the size of its type, the value is limited by the type: a std::uint8_t b : 1000; would still hold values between 0 and 255. the extra bits become unused padding.
Because bit fields do not necessarily begin at the beginning of a byte, address of a bit field cannot be taken. Pointers and non-const references to bit fields are not possible. When initializing a const reference from a bit field, a temporary is created (its type is the type of the bit field), copy initialized with the value of the bit field, and the reference is bound to that temporary.
The type of a bit field can only be integral or enumeration type.
A bit field cannot be a static data member.

Notes

The following properties of bit fields are implementation-defined
  • Everything about the actual allocation details of bit fields within the class object
  • For example, on some platforms, bit fields don't straddle bytes, on others they do
  • Also, on some platforms, bit fields are packed left-to-right, on others right-to-left
  • Whether char, short, int, long, and long long bit fields that aren't explicitly signed or unsigned are signed or unsigned.
  • For example, int b:3; may have the range of values 0..7 or -4..3.
(until C++14)

References

  • C++11 standard (ISO/IEC 14882:2011):
  • 9.6 Bit-fields [class.bit]
  • C++98 standard (ISO/IEC 14882:1998):
  • 9.6 Bit-fields [class.bit]


Ada Alternative

Ada allows the programmer to define bit layouts within a record with much more confidence than can be done by the C++ programmer. The Ada 2012 Reference Manual describes the use of record representation clauses.

13.5.1 Record Representation Clauses

1
record_representation_clause specifies the storage representation of records and record extensions, that is, the order, position, and size of components (including discriminants, if any).

Syntax

2
record_representation_clause ::= 
    
for first_subtype_local_name use
      
record [mod_clause]
        {
component_clause}
      
end record;
3
component_clause ::= 
    
component_local_name at position range first_bit .. last_bit;
4
position ::= static_expression
5
first_bit ::= static_simple_expression
6
last_bit ::= static_simple_expression

Name Resolution Rules

7
Each positionfirst_bit, and last_bit is expected to be of any integer type. 

Legality Rules

8/2
The first_subtype_local_name of a record_representation_clause shall denote a specific record or record extension subtype. 
9
If the component_local_name is a direct_name, the local_name shall denote a component of the type. For a record extension, the component shall not be inherited, and shall not be a discriminant that corresponds to a discriminant of the parent type. If the component_local_name has an attribute_designator, the direct_name of the local_name shall denote either the declaration of the type or a component of the type, and theattribute_designator shall denote an implementation-defined implicit component of the type.
10
The positionfirst_bit, and last_bit shall be static expressions. The value of position and first_bit shall be nonnegative. The value of last_bit shall be no less than first_bit – 1. 
10.1/2
   If the nondefault bit ordering applies to the type, then either: 
10.2/2
the value of last_bit shall be less than the size of the largest machine scalar; or
10.3/2
the value of first_bit shall be zero and the value of last_bit + 1 shall be a multiple of System.Storage_Unit. 
11
At most one component_clause is allowed for each component of the type, including for each discriminant (component_clauses may be given for some, all, or none of the components). Storage places within acomponent_list shall not overlap, unless they are for components in distinct variants of the same variant_part.
12
A name that denotes a component of a type is not allowed within a record_representation_clause for the type, except as the component_local_name of a component_clause.

Static Semantics

13/2
 record_representation_clause (without the mod_clause) specifies the layout.
13.1/2
   If the default bit ordering applies to the type, the positionfirst_bit, and last_bit of each component_clause directly specify the position and size of the corresponding component.
13.2/3
   If the nondefault bit ordering applies to the type, then the layout is determined as follows:
13.3/2
the component_clauses for which the value of last_bit is greater than or equal to the size of the largest machine scalar directly specify the position and size of the corresponding component;
13.4/2
for other component_clauses, all of the components having the same value of position are considered to be part of a single machine scalar, located at that position; this machine scalar has a size which is the smallest machine scalar size larger than the largest last_bit for all component_clauses at that position; the first_bit and last_bit of each component_clause are then interpreted as bit offsets in this machine scalar. 
14
record_representation_clause for a record extension does not override the layout of the parent part; if the layout was specified for the parent type, it is inherited by the record extension. 

Implementation Permissions

15
An implementation may generate implementation-defined components (for example, one containing the offset of another component). An implementation may generate names that denote such implementation-defined components; such names shall be implementation-defined attribute_references. An implementation may allow such implementation-defined names to be used in record_representation_clauses. An implementation can restrict such component_clauses in any manner it sees fit. 
16
If a record_representation_clause is given for an untagged derived type, the storage place attributes for all of the components of the derived type may differ from those of the corresponding components of the parent type, even for components whose storage place is not specified explicitly in the record_representation_clause.

Implementation Advice

17
The recommended level of support for record_representation_clauses is: 
17.1/2
An implementation should support machine scalars that correspond to all of the integer, floating point, and address formats supported by the machine.
18
An implementation should support storage places that can be extracted with a load, mask, shift sequence of machine code, and set with a load, shift, mask, store sequence, given the available machine instructions and run-time model.
19
A storage place should be supported if its size is equal to the Size of the component subtype, and it starts and ends on a boundary that obeys the Alignment of the component subtype.
20/2
For a component with a subtype whose Size is less than the word size, any storage place that does not cross an aligned word boundary should be supported.
21
An implementation may reserve a storage place for the tag field of a tagged type, and disallow other components from overlapping that place. 
22
An implementation need not support a component_clause for a component of an extension part if the storage place is not after the storage places of all components of the parent type, whether or not those storage places had been specified. 
NOTES
23
14  If no component_clause is given for a component, then the choice of the storage place for the component is left to the implementation. If component_clauses are given for all components, the record_representation_clause completely specifies the representation of the type and will be obeyed exactly by the implementation. 

Examples

24
Example of specifying the layout of a record type: 
25
Word : constant := 4;  --  storage element is byte, 4 bytes per word
26
type State         is (A,M,W,P);
type Mode          is (Fix, Dec, Exp, Signif);
27
type Byte_Mask     is array (0..7)  of Boolean;
type State_Mask    is array (State) of Boolean;
type Mode_Mask     is array (Mode)  of Boolean;
28
type Program_Status_Word is
  record
      System_Mask        : Byte_Mask;
      Protection_Key     : Integer range 0 .. 3;
      Machine_State      : State_Mask;
      Interrupt_Cause    : Interruption_Code;
      Ilc                : Integer range 0 .. 3;
      Cc                 : Integer range 0 .. 3;
      Program_Mask       : Mode_Mask;
      Inst_Address       : Address;
end record;
29
for Program_Status_Word use
  record
      System_Mask      at 0*Word range 0  .. 7;
      Protection_Key   at 0*Word range 10 .. 11; -- bits 8,9 unused
      Machine_State    at 0*Word range 12 .. 15;
      Interrupt_Cause  at 0*Word range 16 .. 31;
      Ilc              at 1*Word range 0  .. 1;  -- second word
      Cc               at 1*Word range 2  .. 3;
      Program_Mask     at 1*Word range 4  .. 7;
      Inst_Address     at 1*Word range 8  .. 31;
  end record;
30
for Program_Status_Word'Size use 8*System.Storage_Unit;
for Program_Status_Word'Alignment use 8;
NOTES
31
15  Note on the example: The record_representation_clause defines the record layout. The Size clause guarantees that (at least) eight storage elements are used for objects of the type. The Alignment clause guarantees that aliased, imported, or exported objects of the type will have addresses divisible by eight.

Notice that Ada allows not only the number of bits for each field, it also allows the programmer to specify the value range for each field, the bit location relative to the start of each word of the structure, and even leave some unused bits. C++ requires the use of unnamed bit-fields (with a size greater than 0) to mark unused bits. The C++ compiler has no way to know which bits the programmer wants to skip without specifying an unnamed field. Strangely, an unnamed field with a size of 0 indicates that the next field should start at an allocation unit's boundary, which is highly dependent on the hardware architecture. For instance, on an 8-bit processor the allocation boundary will be every 8 bits, while on a 32-bit processor the allocation boundary might be every 8 bits, 16 bits, or 32 bits, depending upon the processor architecture.

As a software safety engineer I find the implementation-defined aspects of C++ bit-fields to be very unsettling. A project may verify that its C++ bit-fields work as intended on a particular architecture, but when a technology refresh is performed in several years, there is no assurance that the C++ program will continue to work properly on the new hardware. The failure of the C++ program to run on the new hardware will be received as a complete surprise by most users of the upgraded system and by their management. The surprise may be accompanied by hazardous events because of incorrect control of a safety critical system. People may be injured or die, the environment may be seriously damaged, and very expensive systems may be damaged or destroyed. The root cause of the hazards will not be poor functional requirements, poor design, or programming mistakes. The root cause of the hazards will be exposure of implementation-defined behaviors in a programming language. Who will the lawyers sue over the consequences of those hazards?

Ada Web Application 1.0.0 is available

Ada Web Application is a framework to build web applications.

The new version of AWA provides:

  • New countries plugin to provide country/region/city data models
  • New settings plugin to control application user settings
  • New tags plugin to easily add tags in applications
  • New <awa:tagList> and <awa:tagCloud> components for tag display
  • Add tags to the question and blog plugins
  • Add comments to the blog post

AWA can be downloaded at http://blog.vacs.fr/vacs/download.html

A live demonstration of various features provided by AWA is available at http://demo.vacs.fr/atlas

A small tutorial explains how you can easily setup a project, design the UML model, and use the features provided by the Ada Web Application framework.

tag:blogger.com,1999:blog-24476727792496689.post-1127314847775776658

Graph Representation Using an Adjacency List
Summary
The graph abstract data type is very useful for identifying relationships between entities. Graphs can be used to represent navigation on a map, with the entities being the way-points and the connections between the way-points being the named routes, with additional attributes of distance and travel time. Graphs can also be used to represent states and state transitions for finite state diagrams.

Both maps and finite state diagrams benefit from a directed graph, where relationships are directional. There are also undirected graphs, which can be used to model such things as molecular structures, where the atoms are the entities and the connections between them are the chemical bonds.

The following example shows an implementation of an undirected graph with a fixed number of entities. A fixed length graph is an efficient representation when the number of entities you are modeling will not grow, such as when you are modeling the structure of a protein. This example defines a generic data type for a graph. The generic data type allows the programmer to specialize the graph upon instantiation by specifying the type of the entity and the number of entities in the graph.

As is my custom, I am using the Ada programming language for my example. The generic abstract data type is defined in an Ada package, and a simple procedure is written to illustrate how the package is used.

Ada Package Specification
The Ada package specification defines the public interfaces to the abstract data type and the private internal data representations used in the abstract data type.
------------------------------------------------------------------
-- Generic Undirected Graph Package --
------------------------------------------------------------------
generic
type Element is private;
Max_Elements : Positive;
package Fixed_Length_Graph is
subtype Element_Id is Positive range 1..Max_Elements;
type Adjacency_List is array(Element_Id) of Boolean;
type Undirected_Graph is tagged private;
Procedure Add_Element(to : in out Undirected_Graph;
Item : in Element;
Id : in Element_Id);
Procedure Add_Adjacencies(to : in out Undirected_Graph;
Item : in Element_Id;
List : in Adjacency_List);
function Get_Element(From : in Undirected_Graph;
Id : in Element_Id) return Element;
function List_Adjacencies(From : in Undirected_Graph;
Id : in Element_Id) return Adjacency_List;
No_Element_Error : Exception;
private
type Adjacency_Matrix is array(Element_Id) of Adjacency_List;
type Element_Record is record
Filled : Boolean := False;
The_Element : Element;
end record;
type Element_List is array(Element_Id) of Element_Record;
type Undirected_Graph is tagged record
Adjacencies : Adjacency_Matrix := (Others => (Others => False));
Elements : Element_List;
end record;
end Fixed_Length_Graph;

This package provides two public data types: Adjacency_List, which is fully exposed to the public, and Undirected_Graph, which is declared to be private and is therefore an opaque type. The completion of the type Undirected_Graph is seen in the privatesection of the package specification, along with the private types Adjacency_Matrix, Element_Record, and Element_List, which are completely private, having no exposure to the public.
You may notice that Adjacency_List is an array of boolean values and Adjacency_Matrix is an array of Adjacency_List elements.
Ada Package Body
The Ada package body contains the implementation of all the functions and procedures declared in the Ada package specification. The contents of the Ada package body are completely hidden from any the calling subprograms. One consequence of this is that the calling subprogram never needs to be recompiled if only the package body is modified. The calling subprogram depends upon the interface specified in the package specification, not upon the implementation of that interface.
package body Fixed_Length_Graph is



-----------------
-- Add_Element --
-----------------



procedure Add_Element(to : in out Undirected_Graph;
                    Item : in Element;
                      Id : in Element_Id)is
begin
   To.Elements(Id).The_Element := Item;
   To.Elements(Id).Filled := True;
end Add_Element;



---------------------
-- Add_Adjacencies --
---------------------



procedure Add_Adjacencies(to : in out Undirected_Graph;
                        Item : in Element_Id;
                        List : in Adjacency_List) is
begin
   for I in List'Range loop
      To.Adjacencies(Item)(I) := List(I);
      To.Adjacencies(I)(Item) := List(I);
   end loop;
end Add_Adjacencies;



-----------------
-- Get_Element --
-----------------



function Get_Element(From : in Undirected_Graph;
                       Id : in Element_Id) return Element is
begin
   if From.Elements(Id).Filled then
      return From.Elements(ID).The_Element;
   else
      raise No_Element_Error;
   end if;
end Get_Element;



----------------------
-- List_Adjacencies --
----------------------



function List_Adjacencies(From : in Undirected_Graph;
                            Id : in Element_Id) return Adjacency_List is
begin
   return From.Adjacencies(Id);
end List_Adjacencies;



end Fixed_Length_Graph;
Remember that the Adjacency_Matrix is defined as an array of arrays, not as a two-dimensional array. This was done to simplify the ability to return the adjacencies associated with a specific entity or node.

Testing the Undirected Graph Package
In this test I have decided to create a graph of bounded string values. The graph I am representing is shown in the diagram below.



Test Source Code
------------------------------------------------------------------
-- Second test of Fixed_Length_Graph package --
------------------------------------------------------------------
with Ada.Text_Io; use Ada.Text_IO;
with Ada.Strings.Bounded;
with Fixed_Length_Graph;

procedure Graph_Test_02 is
package B_Strings is new Ada.Strings.Bounded.Generic_Bounded_Length(25);
use B_Strings;
package Str_Graph is new Fixed_Length_Graph(B_Strings.Bounded_String, 7);
use Str_Graph;
The_Graph: Undirected_Graph;
Adj_List : Adjacency_List;

Subtype Index is Positive range 1..7;
type Str_Array is array(Index) of B_Strings.Bounded_String;
Names : Str_Array;


Adj_Array : Array(Index) of Adjacency_List;

begin
Names(1) := To_Bounded_String("One");
Names(2) := To_Bounded_String("Two");
Names(3) := To_bounded_String("Three");
Names(4) := To_Bounded_String("Four");
Names(5) := To_Bounded_String("Five");
Names(6) := To_Bounded_String("Six");
Names(7) := To_Bounded_String("Seven");
for I in Names'Range loop
The_Graph.Add_Element(Names(I), I);
end loop;
Adj_Array(1) := (2 => True, 3 => True, Others => False);
Adj_Array(2) := (1 => True, 3 => True, 4 => True, Others => False);
Adj_Array(3) := (1 => True, 2 => True, Others => False);
Adj_Array(4) := (2 => True, 5 => True, 6 => True, Others => False);
Adj_Array(5) := (4 => True, 7 => True, Others => False);
Adj_Array(6) := (4 => True, 7 => True, Others => False);
Adj_Array(7) := (5 => True, 6 => True, Others => False);

for I in Adj_Array'Range loop
The_Graph.Add_Adjacencies(I, Adj_Array(I));
end loop;

for I in Element_Id'Range loop
Put(To_String(The_Graph.Get_Element(I)) & "-> ");
Adj_List := The_Graph.List_Adjacencies(I);
for J in Adj_List'Range loop
if Adj_List(J) = True then
Put(To_String(The_Graph.Get_Element(J)) & " ");
end if;
end loop;
New_Line;
end loop;

end Graph_Test_02;

The output of this program is:



One-> Two Three
Two-> One Three Four
Three-> One Two
Four-> Two Five Six
Five-> Four Seven
Six-> Four Seven

Seven-> Five Six

Relocating GCC

AdaCore's doinstall is an excellent way of installing the compiler where you want to. Unfortunately, GCC 4.9 uses the shared libgcc_s.1.dylib, which has no @rpath-type constructs, and so the compiler executables expect to find libgcc_s.1.dylib in the place it was built for. (Not to mention libstdc++.6.dylib.)

Read more »

Parallel Addition Revisited

In an earlier article I discussed aspects of parallel addition of elements of an array. A more general problem would be to sum a set of numbers from a collection of numbers. The collection cannot be simply an arbitrary unending stream of numbers, because a sum of such a stream could never be completed. Instead, it must be some discrete sample size of numbers. Furthermore, the sample size cannot be zero. There must be at least one number in the sample or no sum is possible.

The following example collects a sample of numbers into a queue and then uses concurrent tasks to perform pair-wise addition of the queue elements. Each result of pair-wise addition is placed back on the queue. Eventually, given a discrete number of items in the queue, the queue will be left containing only one value. That value will be the total of all the operations on the set of numbers. This approach works because addition is commutative. The order the numbers are added is irrelevant to the solution.

Parallel Addition In Ada

The following source code accomplishes this more general parallel addition capability.
The key to the operation of the program is the protected object Queue, which contains the list of numbers shared by all the parallel tasks.
Each task performing addition calls the entry Get_Two, which dequeues two integers from the Queue object. The task then adds the two integers and calls the procedure Enqueue to place the result on the Queue object.

Parallel_Addition.ads
------------------------------------------------------------------

-- Parallel Addition Package                                    --

------------------------------------------------------------------

with Ada.Containers.Doubly_Linked_Lists;


package Parallel_Addition is

   Package Int_Queue is new Ada.Containers.Doubly_Linked_Lists(Integer);

   use Int_Queue;


   protected Queue is

      Entry Get_Two(Item1, Item2 : out Integer);

      Entry Dequeue(Item : out Integer);

      Procedure Enqueue(Item : in Integer);

      Procedure Clear;

      Function Count return Integer;

   private

      Nums : Int_Queue.List;

   end Queue;


   task type Adder;


end Parallel_Addition;

Inner workings of the Parallel_Addition package

I have chosen the Doubly Linked List package provided by the Ada container library to implement my queue. The Enqueue procedure appends values to the end of the list (queue) and both the Get_Two and Dequeue entries dequeue values from the beginning of the list (queue).


Ada entries have a boundary condition. The boundary condition for the Get_Two entry evaluates to TRUE when the list contains more than 1 element. The boundary condition for the Dequeue entry evaluates to TRUE when the list contains more than 0 elements. The Clear procedure empties the list. The Count function reports the number of tasks suspended on the Get_Two entry queue. Every task calling an entry will suspend until the boundary condition evaluates to TRUE. The tasks will then be allowed to execute the entry in FIFO order, ensuring that all tasks are allowed to reliably access the entry.


The Adder task type contains an infinite loop which simply calls Get_Two to dequeue two values from the Queue object, then Enqueues the sum of those two values onto the Queue. Since every pair of values is replaced with a single value, the size of the Queue rapidly gets smaller. Once there is only one value left in the Queue, the Adder tasks will all suspend waiting for a second value. The last value left on the Queue is the total of all the numbers placed on the Queue.


Parallel_Addition.adb
with Ada.Containers; use Ada.Containers;

package body Parallel_Addition is

   -----------

   -- Queue --

   -----------

   --------------------------------------------------------------------

   -- The Queue protected object treats its internal list as a queue.--

   -- All data is read from the head of the list and new data is     --

   -- appended to the end of the list. Reading data from the head    --

   -- also deletes that data from the queue.                         --

   --                                                                --

   -- The Count function reports the number of tasks waiting in the  --

   -- entry queue for the Get_Two entry.                             --

   -- The Clear procedure empties the internal list of its contents. --

   --------------------------------------------------------------------

   protected body Queue is

   -------------

   -- Get_Two --

   -------------

   entry Get_Two (Item1, Item2 : out Integer) when Nums.Length > 1 is

   begin

      Item1 := Nums.First_Element;

      Nums.Delete_First;

      Item2 := Nums.First_Element;

      Nums.Delete_First;

   end Get_Two;


   -------------

   -- Dequeue --

   -------------

   entry Dequeue (Item : out Integer) when Nums.Length > 0 is

   begin

      Item := Nums.First_Element;

      Nums.Delete_First;

   end Dequeue;


   -------------

   -- Enqueue --

   -------------

   procedure Enqueue (Item : in Integer) is

   begin

      Nums.Append(Item);

   end Enqueue;


   -----------

   -- Count --

   -----------


   function Count return Integer is

   begin

      Return Get_Two'Count;

   end Count;


   -----------

   -- Clear --

   -----------

   procedure Clear is

   begin

      Nums.Clear;

   end Clear;

   end Queue;


   -----------

   -- Adder --

   -----------

   ---------------------------------------------------------------------

   -- Each Adder task simply calls Get_Two to dequeue two values from --

   -- the queue. It then enqueues the sum of those two values back    --

   -- on the queue. The queue will contain the final sum when it      --

   -- contains only a single value and no tasks are holding the lock  --

   -- for the Get_Two entry.                                          --

   ---------------------------------------------------------------------

   task body Adder is

      Value1, Value2 : Integer;

   begin

      Loop

         Queue.Get_Two(Value1, Value2);

         Queue.Enqueue(Value1 + Value2);

      end loop;

   end Adder;

end Parallel_Addition;

A test driver for the Parallel_Addition package

The Parallel_Addition_Main procedure is my test driver for the Parallel_Addition package.

The subtype The_Nums is created to define a range of values to add. In the source code below the range of values is specified as -600 through 601 inclusive. The sum of this set of numbers should be 601.

An array of Adder tasks is created. The tasks start running immediately. Since there are no values in the Queue protected object, all the tasks will suspend in the Get_Two entry queue waiting for the boundary condition to evaluate to TRUE.

The test driver performs the addition 20 times. This is done to reveal any race conditions that might exist in the code. For each iteration of the test the Queue is cleared and the numbers are Enqueued into the Queue object. The test driver then polls the Queue.Count function to determine when all the Adder tasks are once again suspended in the Get_Two entry queue. That event indicates there is only one value left in the Queue, which is our total. That final value is Dequeued and displayed.
After the 20 iterations all the Adder tasks are aborted and the program ends in an orderly manner.

Parallel_Addition_Main.adb
------------------------------------------------------------------

-- Parallel Addition Main Program                               --

--                                                              --

-- This program uses a task pool contained in the array named   --

-- workers. The task pool is reused for multiple iterations.    --

-- The tasks are aborted at the end of the program.             --

------------------------------------------------------------------

with Parallel_Addition; use Parallel_Addition;

with Ada.Text_IO; use Ada.Text_IO;

with Ada.Task_Identification; use Ada.Task_Identification;


procedure Parallel_Addition_Main is

   subtype The_Nums is Integer range -600..601;

   Workers : array(1..3) of Adder;

   Total : Integer;

begin

   for I in 1..20 loop

      Put(I'Img & " ");

      Queue.Clear;

      for I in The_Nums'Range loop

         Queue.Enqueue(I);

      end loop;


      Loop

         exit when Queue.Count = Workers'Length;

      end loop;


      Queue.Dequeue(Total);

      Put_Line("The total of the series of numbers from " &

                The_Nums'First'Img & " to " &

                The_Nums'Last'Img & " is " &

                Total'Img);

   end loop;


   for Worker of Workers loop

      Abort_Task(Worker'Identity);

   end loop;

end Parallel_Addition_Main;


Program output
 1 The total of the series of numbers from -600 to  601 is  601

 2 The total of the series of numbers from -600 to  601 is  601

 3 The total of the series of numbers from -600 to  601 is  601

 4 The total of the series of numbers from -600 to  601 is  601

 5 The total of the series of numbers from -600 to  601 is  601

 6 The total of the series of numbers from -600 to  601 is  601

 7 The total of the series of numbers from -600 to  601 is  601

 8 The total of the series of numbers from -600 to  601 is  601

 9 The total of the series of numbers from -600 to  601 is  601

 10 The total of the series of numbers from -600 to  601 is  601

 11 The total of the series of numbers from -600 to  601 is  601

 12 The total of the series of numbers from -600 to  601 is  601

 13 The total of the series of numbers from -600 to  601 is  601

 14 The total of the series of numbers from -600 to  601 is  601

 15 The total of the series of numbers from -600 to  601 is  601

 16 The total of the series of numbers from -600 to  601 is  601

 17 The total of the series of numbers from -600 to  601 is  601

 18 The total of the series of numbers from -600 to  601 is  601

 19 The total of the series of numbers from -600 to  601 is  601

 20 The total of the series of numbers from -600 to  601 is  601


Ada 2012 Aspect Clauses => Static Predicates

John English wrote a wonderful book titled Ada 95: The Craft of Object-Oriented Programming, which is available on line at http://archive.adaic.com/docs/craft/html/contents.htm. In chapter 3 of that book he explores many Ada programming fundamentals using a simple calculator program example. The code for that example is:

    with Ada.Text_IO, Ada.Integer_Text_IO;

    use  Ada.Text_IO, Ada.Integer_Text_IO;

    procedure Calculator is

        Result   : Integer;

        Operator : Character;

        Operand  : Integer;

    begin

        Put ("Enter an expression: ");

        Get (Result);                                   --  1

        loop                                            --  2

            loop                                        --  3

                Get (Operator);

                exit when Operator /= ' ';

            end loop;

            if Operator = '.' then                      --  4

                Put (Result, Width => 1);               --  5

                exit;                                   --  6

            else

                Get (Operand);                          --  7

                case Operator is

                    when '+' =>

                        Result := Result + Operand;     --  8

                    when '-' =>

                        Result := Result - Operand;

                    when '*' =>

                        Result := Result * Operand;     --  9

                    when '/' =>

                        Result := Result / Operand;

                    when others =>

                        Put ("Invalid operator '");     -- 10

                        Put (Operator);

                        Put ("'");

                        exit;                           -- 11

                end case;

            end if;

        end loop;

        New_Line;

    end Calculator;

This program implements a simple left-to-right calculator that does not understand parentheses. Each calculation string is terminated with a period (full stop for those speaking the King’s English).

1 + 2 * 3.

The calculation string above is evaluated left to right, yielding the value 9. The calculator does not impose any operator precedence.

The internal loop beginning with the line labeled 3 in an end-of-line comment deals with the fact that the Get procedure for type Character simply gets the next character in the input stream. It does not skip space characters to input the next non-space character. The loop implemented by John English simply reads characters until it encounters something that is not a space character. The hope implicit in this program is that the person creating the input strings only uses integral numbers, spaces, or one of the characters ‘+’, ‘-‘, ‘*’, ‘-‘, or ‘.’. If it encounters any other character it declares that an invalid operator has been input and terminates the program.

As a software safety engineer I am always uncomfortable with a program that cannot clearly and concisely specify simple input values. What happens, for instance, in the John English version of this program if the person running the program inputs horizontal tabs instead of spaces? They may look similar on an editor screen, but they are distinctly different to program.

I know that John English was well aware of these issues, but was trying to introduce students to the fundamentals of Ada programming rather than the complications of error handling. In fact, until the 2012 version of Ada there was no simple way to do better.

Ada 2012 introduced aspect clauses. The form of the aspect clause of interest to this article is the static predicate. A static predicate is a qualification of a type or subtype definition defining a set of properties about the type. In Ada 95 the best you could do was to specify the range of values for a subtype or type. That range had to be contiguous, with no gaps in the values. The Ada 2012 static predicate definition introduces more flexibility. It allows any expression that can be evaluated as a membership test.

How does this relate to the calculator program shown above? The operators in that program are five distinct characters, but not a contiguous range of characters. Let’s see how we could express that set of characters using an Ada 2012 static predicate.


Subtype Acceptable is Character

   with Static_Predicate => Acceptable in ‘+’|’-‘|’*’|’/’|’.’;


The result is a subtype of Character with five valid values.

Once we have established a subtype with only the few values we want to use, we have managed to more clearly express the intent of our program. A comparable program to the Calculator program above, but using this static predicate expression is:
------------------------------------------------------------------

-- Simple Calculator Program                                    --

------------------------------------------------------------------

with Ada.Text_IO; use Ada.Text_IO;

with Ada.Integer_Text_Io; use Ada.Integer_Text_IO;


procedure Simple_Calculator is

   subtype Acceptable is Character

   with Static_Predicate => Acceptable in '+'|'-'|'*'|'/'|'.';


   function Get_Operator return Acceptable is

      Temp : Character;

   begin

      loop

         get(Temp);

         exit when Temp in Acceptable;

      end loop;

      return Temp;

   end Get_Operator;


   Operator : Acceptable;

   Operand  : Integer;

   Result   : Integer;

begin

   Get(Item => Result);

   Outer:

   loop

      Operator := Get_Operator;


      if Operator = '.' then

         Put(Item => Result, Width => 1);

         New_Line;

         exit Outer when End_Of_File;

         Get(Item => Result);

      else

         Get(Item => Operand);

         case Operator is

         when '+' => Result := Result + Operand;

         when '-' => Result := Result - Operand;

         when '*' => Result := Result * Operand;

         when '/' => Result := Result / Operand;

         when '.' => null;

         end case;

      end if;

   end loop Outer;

end Simple_Calculator;

I have encapsulated the operator input loop into a function to clearly specify my intentions. Note that the function Get_Operator now loops until it reads a character that is a member of the subtype Acceptable. This logic will read past spaces, tabs, or any other characters that are not members of the subtype Acceptable. The case statement now does not need a “when Others” clause because it explicitly handles all possible values of subtype Acceptable. If another operator were to be added to the set of values for Acceptable the compiler would flag the need to handle the new value in the case statement.
The use of the Static Predicate to create a discontinuous set of valid values can be very useful. It also greatly simplifies programming over creating a more complex set of conditional statements on an input loop. Finally, it allows a more robust use of the case clause.

Shared Resource Design Patterns

Summary

Many applications are constructed of groups of cooperating threads of execution. Historically this has frequently been accomplished by creating a group of cooperating processes. Those processes would cooperate by sharing data. At first, only files were used to share data. File sharing presents some interesting problems. If one process is writing to the file while another process reads from the file you will frequently encounter data corruption because the reading process may attempt to read data before the writing process has completely written the information. The solution used for this was to create file locks, so that only one process at a time could open the file. Unix introduced the concept of a Pipe, which is effectively a queue of data. One process can write to a pipe while another reads from the pipe. The operating system treats data in a pipe as a series of bytes. It does not let the reading process access a particular byte of data until the writing process has completed its operation on the data.
Various operating systems also introduced other mechanisms allowing processes to share data. Examples include message queues, sockets, and shared memory. There were also special features to help programmers control access to data, such as semaphores. When operating systems introduced the ability for a single process to operate multiple threads of execution, also known as lightweight threads, or just threads, they also had to provide corresponding locking mechanisms for shared data.
Experience shows that, while the variety of possible designs for shared data is quite large, there are a few very common design patterns that frequently emerge. Specifically, there are a few variations on a lock or semaphore, as well as a few variations on data buffering. This paper explores the locking and buffering design patterns for threads in the context of a monitor. Although monitors can be implemented in many languages, all examples in this paper are presented using Ada protected types. Ada protected types are a very thorough implementation of a monitor.

Monitors

There are several theoretical approaches to creating and controlling shared memory. One of the most flexible and robust is the monitor as first described by C.A.R. Hoare. A monitor is a data object with three different kinds of operations.

Procedures are used to change the state or values contained by the monitor. When a thread calls a monitor procedure that thread must have exclusive access to the monitor to prevent other threads from encountering corrupted or partially written data.

Entries, like procedures, are used to change the state or values contained by the monitor, but an entry also specifies a boundary condition. The entry may only be executed when the boundary condition is true. Threads that call an entry when the boundary condition is false are placed in a queue until the boundary condition becomes true. Entries are used, for example, to allow a thread to read from a shared buffer. The reading thread is not allowed to read the data until the buffer actually contains some data. The boundary condition would be that the buffer must not be empty. Entries, like procedures, must have exclusive access to the monitor's data.

Functions are used to report the state of a monitor. Since functions only report state, and do not change state, they do not need exclusive access to the monitor's data. Many threads may simultaneously access the same monitor through functions without danger of data corruption.

The concept of a monitor is extremely powerful. It can also be extremely efficient. Monitors provide all the capabilities needed to design efficient and robust shared data structures for threaded systems.
Although monitors are powerful, they do have some limitations. The operations performed on a monitor should be very fast, with no chance of making a thread block. If those operations should block, the monitor will become a road block instead of a communication tool. All the threads awaiting access to the monitor will be blocked as long as the monitor operation is blocked. For this reason, some people choose not to use monitors. There are design patterns for monitors that can actually be used to work around these problems. Those design patterns are grouped together as locking patterns.

Locking Patterns

This paper explores three locking patterns, binary semaphores, counting semaphores, and burst locks.

Binary Semaphore

Binary semaphores are used to provide exclusive locking for a thread on a resource. Only one thread at a time may "hold" the semaphore. All others must wait until their turn with the semaphore. If you want to lock access to a potentially blocking resource, you should acquire a semaphore for that resource just before accessing it. and release the semaphore upon completing your access to the resource. The following code block defines the interface to a monitor implementing a binary semaphore.
   protected type Binary_Semaphore is
      entry Acquire;
      procedure Release;
   private
      Locked : Boolean := False;
   end Binary_Semaphore;
This monitor has two operations defined. The entry Acquire allows a thread (or task as they are called in Ada) to acquire the semaphore if no other task currently holds the semaphore. The procedure Release unconditionally releases the semaphore. The private data for this monitor is a singleboolean value, Locked, which is initialized to False .
The actual workings of the monitor are specified in the body of the protected type.
   protected body Binary_Semaphore is
      entry Acquire when not Locked is
      begin
         Locked := True;
      end Acquire;

 

      procedure Release is
      begin
         Locked := False;
      end Release;
   end Binary_Semaphore;
Note that you can only acquire the binary semaphore when it is not already locked. Acquiring the semaphore causes it to be locked. The Release procedure simply unlocks the semaphore.

Counting Semaphore

Sometimes you want to access a resource with the ability to handle a limited number of simultaneous accesses. In this case, you will want to use a counting semaphore. This variation on the semaphore allows up to a predetermined maximum number of threads or tasks to hold the semaphore simultaneously. The interface for a counting semaphore looks a lot like the interface for a binary semaphore.
   protected type Counting_Semaphore(Max : Positive) is
      entry Acquire;
      procedure Release;
   private
      Count : Natural := 0;
   end Counting_Semaphore;
In this case, when the semaphore is created you must specify the maximum number of tasks you want to simultaneously hold this semaphore. The private data for this semaphore is a simple integer value, counting the current number of tasks currently holding the semaphore. In the case of a counting semaphore, the boundary condition for the Acquire entry is that the Count cannot exceed the value of Max. The implementation of the counting semaphore simply manipulates the Count.
   protected body Counting_Semaphore is
      entry Acquire when Count < Max is
      begin
         Count := Count + 1;
      end Acquire;

 

      procedure Release is
      begin
         if Count > 0 then
            Count := Count - 1;
         end if;
      end Release;
   end Counting_Semaphore;
Note that the Release procedure uses a conditional to ensure that Count is never assigned a negative value.

Burst Lock

The next locking pattern we will explore is the burst lock. This pattern allows some specified number of tasks simultaneous access to a resource. Access to the resource is granted based upon the number of tasks waiting to access the resource. This pattern is good for short duration resource accesses when there is a limited bandwidth for communication to the resource. You can use this pattern to optimize the number of simultaneous accesses to the resource.
   protected type Burst(Sample_Size : Positive) is
      entry Request_Access;
      procedure Grant_Access;
   private
      Release : Boolean := False;
   end Burst;
You specify the number of tasks in a burst when you create an instance of this type. Note that there is an entry Request_Access and a procedure Grant_Access. The entry queues up requests until Sample_Size tasks are waiting to access the resource. The procedure Grant_Access is used to send a burst through when fewer than Sample_Size tasks are waiting.
   protected body Burst is
      entry Request_Access when Request_Access'Count = Sample_Size or Release is
      begin
         if Request_Access'Count > 0 then
            Release := True;
         else
            Release := False;
         end if;
      end Request_Access;

 

      procedure Grant_Access is
      begin
         Release := True;
      end Grant_Access;
   end Burst;
The Request_Access entry does all the interesting work in this pattern. The expression Request_Access'Count evaluates to the number of tasks queued up to wait for this entry. The boundary condition is true when the number of waiting tasks equals Sample_Size or Release is true. When the boundary condition becomes true, the entry sets Release to True until no more tasks are queued. At that point Release is set to False so that access to the resource will once again be blocked.

Squad Locks

A squad lock allows a special task (the squad leader) to monitor the progress of a herd or group of worker tasks. When all (or a sufficient number) of the worker tasks are done with some aspect of their work, and the leader is ready to proceed, the entire set of tasks is allowed to pass a barrier and continue with the next sequence of their activities. The purpose is to allow tasks to execute asynchronously, yet coordinate their progress through a complex set of activities.
package Barriers is
   protected type Barrier(Trigger : Positive) is
      entry Wait_For_Leader; 
      entry Wait_For_Herd; 
      procedure Leader_Done; 
   private
      Done : Boolean := False;
   end Barrier;

 

   protected type Autobarrier(Trigger : Positive) is
      entry Wait_For_Leader; 
      entry Wait_For_Herd; 
   private
      Done : Boolean := False;
   end Autobarrier;
end Barriers;
This package shows two kinds of squad lock. The Barrier protected type demonstrates a basic squad lock. The herd calls Wait_For_Leader and the leader calls Wait_For_Herd and then Leader_Done. The Autobarrier demonstrates a simpler interface. The herd calls Wait_For_Leader and the leader calls Wait_For_Herd. The Trigger parameter is used when creating an instance of either type of barrier. It sets the minimum number of herd tasks the leader must wait for before it can proceed.
package body Barriers is
   protected body Barrier is
      entry Wait_For_Herd when Wait_For_Leader'Count >= Trigger is
      begin
         null;
      end Wait_For_Herd;

 

      entry Wait_For_Leader when Done is
      begin
         if Wait_For_Leader'Count = 0 then
            Done := False;
         end if;
      end Wait_For_Leader;

 

      procedure Leader_Done is
      begin
         Done := True;
      end Leader_Done;
   end Barrier;

 

   protected body Autobarrier is
      entry Wait_For_Herd when Wait_For_Leader'Count >= Trigger is
      begin
         Done := True;
      end Wait_For_Herd;

 

      entry Wait_For_Leader when Done is
      begin
         if Wait_For_Leader'Count = 0 then
            Done := False;
         end if;
      end Wait_For_Leader;
   end Autobarrier;
end Barriers;

Buffer Patterns

Buffer patterns are used when you want the monitor to control data shared by two or more tasks. The kind of buffer you use will vary with your needs. If all the data produced by one thread must be read by the another thread, then you want to use a buffer containing one or more data elements. Buffers containing only one data element cause the reading and writing tasks to become synchronized around the read and write operations. Buffers containing many data elements allow greater asynchronous operation of the reading and writing tasks. Multi-element buffers can either be bounded, with a fixed maximum size, or unbounded, being dynamically allocated and de-allocated as needed. Bounded buffers offer fixed amount of memory usage. Unbounded buffers offer less blocking due to the buffer being full.
Additional patterns are available when the reading task only needs a time based sample of the data from the writing task, or when the reading task only needs to be sure it is not reading duplicate data points.

Bounded Buffer

The bounded buffer holds a limited collection of data items. Any task reading from the bounded buffer can only read data when the buffer contains data. Any task writing to the bounded buffer can only write data when the buffer is not full. You could make a variation of the bounded buffer having the write operation be a procedure. When the buffer is full it will overwrite the oldest data item in the buffer. The example below demonstrates the former version, where the writing task suspends when the buffer is full.
   type Element_Array is array(Natural range <>) of Element_Type;

 

   protected type Bounded_Buffer(Max : Positive) is
      entry Put(Item : in Element_Type);
      entry Get(Item : out Element_Type);
      function Size return Natural;
   private
      Elements  : Element_Array(0..Max);
      Put_Index : Natural := 0;
      Get_Index : Natural := 0;
      Count     : Natural := 0;
   end Bounded_Buffer;
The internal array Elements is treated as a circular queue of data. When the queue is full the Put entry blocks. When the queue is empty the Get entry blocks. The implementation of the bounded buffer is very simple.
   protected body Bounded_Buffer is
      entry Put(Item : in Element_Type) when Size < Elements'Length is
      begin
         Elements(Put_Index) := Item;
         Put_Index := (Put_Index + 1) mod Elements'Length;
         Count := Count + 1;
      end Put;

 

      entry Get(Item : out Element_Type) when Size > 0 is
      begin
         Item := Elements(Get_Index);
         Get_Index := (Get_Index + 1) mod Elements'Length;
         Count := Count - 1;
      end Get;

 

      function Size return Natural is
      begin
         return Count;
      end Size;
   end Bounded_Buffer;
The Put entry barrier is true as long as the Elements array is not full. The Get entry barrier is true as long as the Elements array is not empty. This design pattern conserves memory while ensuring that all data produced by the writing task will be available to the reading task.

Unbounded Buffer

The unbounded buffer uses varying amounts of memory, but also tends to minimize blocking for the writing task. One danger of this pattern is that you can run out of memory on your system if the writing task is consistently faster than the reading task for an extended period of time. For this reason, it is best to use unbounded buffers only when, on average, the writing task is no faster than the reading task.
   type Node;

 

   type Node_Access is access Node;

 

   type Node is record
      Value : Element_Type;
      Next  : Node_Access := null;
   end record;

 

   protected type Unbounded_Buffer is
      procedure Put(Item : in Element_Type);
      entry Get(Item : out Element_Type);
      function Size return Natural;
   private
      Head : Node_Access := null;
      Tail : Node_Access := null;
      Count : Natural := 0;
   end Unbounded_Buffer;
The unbounded buffer maintains a simple linked list of data elements. The Get entry is still limited by the boundary condition that the buffer cannot be empty when you get a data item.
   protected body Unbounded_Buffer is
      procedure Put(Item : in Element_Type) is
         Temp_Node : Node_Access := new Node;
      begin
         Temp_Node.Value := Item;
         if Tail = null then
            Head := Temp_Node;
            Tail := Temp_Node;
         else
            Tail.Next := Temp_Node;
            Tail := Tail.Next;
         end if;
         Count := Count + 1;
      end Put;

 

      entry Get(Item : out Element_Type) when Head /= null is
         procedure Free is new 
            Ada.Unchecked_Deallocation(Object => Node, Name => Node_Access);
         Temp : Node_Access;
      begin
         Item := Head.Value;
         Temp := Head;
         Head := Head.Next;
         if Head = null then
            Tail := null;
         end if;
         Free(Temp);
         Count := Count - 1;
      end Get;

 

      function Size return Natural is
      begin
         return Count;
      end Size;
   end Unbounded_Buffer;
This implementation adds to the tail of the linked list and reads (and deletes) from the head of the linked list. Every Put allocates a new node while every Get deallocates an existing node. These operations can be much slower than the corresponding bounded buffer operations due to the need to dynamically manage the data. In general, for long running applications, it is safer to use the bounded buffer than the unbounded buffer because you can run out of memory if the Put operations occur more often than the Get operations.

Single Element Buffers

There are a variety of single element buffer design patterns. I will deal with three of them.

Unconditional Buffer

A single element buffer without any access barrier is used when the reading task only needs to sample data from the writing task. If the reading task executes faster than the writing task, the reading task will read the same value more than once. If the writing task executes faster than the reading task some values will be skipped. Unconditional buffers are often used when sampling sensor data. Sensor data may be delivered to a program at a rate many times faster than it can be analyzed. The unconditional buffer simplifies the communication between the task reading from the sensor and the task analyzing the sensor data.
   protected type Read_Any_Buffer is
      procedure Put(Item : in Element_Type);
      function Get return Element_Type;
      function Initialized return Boolean;
   private
      Value    : Element_Type;
      Is_Valid : Boolean := False;
   end Read_Any_Buffer;
One issue with an unconditional buffer is determining if it contains valid data. It is unreasonable for the reading task to read uninitialized data. The function initialized can be polled to determine when the unconditional buffer has been initialized. After that happens the reading task merely calls the Get function whenever it wants access to the current value in the buffer.
   protected body Read_Any_Buffer is
      procedure Put(Item : in Element_Type) is
      begin
         Value    := Item;
         Is_Valid := True;
      end Put;

 

      function Get return Element_Type is
      begin
         if not Is_Valid then
            raise Uninitialized_Data;
         end if;
         return Value;
      end Get;

 

      function Initialized return Boolean is
      begin
         return Is_Valid;
      end Initialized;
   end Read_Any_Buffer;
This example has the Get function raise the exception Uninitialized_Data if the function is called before data is initialized. The exception logic was placed in this function for safety only. It is much more efficient to poll the Initialized function than to iteratively handle exceptions.

Conditional Read Buffer

Sometimes you want the reading task to only read data it has not seen before. The conditional read buffer handles this by allowing a conditional read. If the reading task is faster than the writing task this buffer will cause both tasks to synchronize around the write to the buffer.
   protected type Read_New_Buffer is
      procedure Put(Item : in Element_Type);
      entry Get(Item : out Element_Type);
   private
      Value  : Element_Type;
      Is_New : Boolean := False;
   end Read_New_Buffer;
Instead of an initialization flag I have provided an Is_New flag. Logically, once the reading task reads a data point that data becomes invalid. Another read cannot occur until the data is refreshed by the writing task.
   protected body Read_New_Buffer is
      procedure Put(Item : in Element_Type) is
      begin
         Value  := Item;
         Is_New := True;
      end Put;

 

      entry Get(Item : out Element_Type) when Is_New is
      begin
         Item   := Value;
         Is_New := False;
      end Get;
   end Read_New_Buffer;
The act of reading the buffer causes the data in the buffer to become invalid for another read. This pattern works for a system with a single reader task. If you have multiple reader tasks you must get more creative. One solution is to replace the Is_New boolean value with an array of booleanvalues, one for each reader. Another is to accompany the data value with a serial number. The reading task must keep track of the serial number of the last read data and reject the data if the serial number is unchanged.

Conditional Read Write Buffer

The conditional read write buffer is used when you want the reading task to read every value produced by the writing task. This buffer pattern causes the reading and writing tasks to always synchronize around the buffer reads and writes. If you really need this guarantee of data delivery you should carefully consider using the Unbounded Buffer pattern. The unbounded buffer allows a little more variation is speed between the reading and writing tasks. However, if one of the tasks is always faster than the other, the conditional read write buffer will perform faster than the unbounded buffer.
   protected type Read_Write_New_Buffer is
      entry Put(Item : in Element_Type);
      entry Get(Item : out Element_Type);
   private
      Value  : Element_Type;
      Is_New : Boolean := False;
   end Read_Write_New_Buffer;
Note that both the Put and the Get operations are conditional. Only one boolean value is needed to control both operations.
   protected body Read_Write_New_Buffer is
      entry Put(Item : in Element_Type) when not Is_New is
      begin
         Value  := Item;
         Is_New := True;
      end Put;

 

      entry Get(Item : out Element_Type) when Is_New is
      begin
         Item   := Value;
         Is_New := False;
      end Get;
   end Read_Write_New_Buffer;
The writing task can only write to the buffer when the data is not new. The reading task can only read from the buffer when the data is new. This pattern is faster than the bounded or unbounded buffer patterns because there is no collection manipulation. The bounded buffer requires calculations of put and get indices. The unbounded buffer requires memory allocation for every put and de-allocation for every get.
Whenever possible I suggest you use the single element buffers instead of the bounded or unbounded buffers. Most of the time one of your tasks will always be faster than the other in a read/write pair. In those cases you can avoid extra overhead, and maximize data throughput by using the single element buffers. The single element buffers also have the virtue of using less memory, which may be a concern in an embedded real time system.

Complete Ada Packages for Examples

Locks

package Locks is
   protected type Burst(Sample_Size : Positive) is
      entry Request_Access;
      procedure Grant_Access;
   private
      Release : Boolean := False;
   end Burst;

 

   protected type Counting_Semaphore(Max : Positive) is
      entry Acquire;
      procedure Release;
   private
      Count : Natural := 0;
   end Counting_Semaphore;

 

   protected type Binary_Semaphore is
      entry Acquire;
      procedure Release;
   private
      Locked : Boolean := False;
   end Binary_Semaphore;
end Locks;

 

package body Locks is
   protected body Burst is
      entry Request_Access when Request_Access'Count = Sample_Size or Release is
      begin
         if Request_Access'Count > 0 then
            Release := True;
         else
            Release := False;
         end if;
      end Request_Access;

 

      procedure Grant_Access is
      begin
         Release := True;
      end Grant_Access;
   end Burst;

 

   protected body Counting_Semaphore is
      entry Acquire when Count < Max is
      begin
         Count := Count + 1;
      end Acquire;

 

      procedure Release is
      begin
         if Count > 0 then
            Count := Count - 1;
         end if;
      end Release;
   end Counting_Semaphore;

 

   protected body Binary_Semaphore is
      entry Acquire when not Locked is
      begin
         Locked := True;
      end Acquire;

 

      procedure Release is
      begin
         Locked := False;
      end Release;
   end Binary_Semaphore;
end Locks;

Buffers

generic

 

   type Element_Type is private;

 

package Buffers is
   type Element_Array is array(Natural range <>) of Element_Type;

 

   protected type Bounded_Buffer(Max : Positive) is
      entry Put(Item : in Element_Type);
      entry Get(Item : out Element_Type);
      function Size return Natural;
   private
      Elements : Element_Array(0..Max);
      Put_Index : Natural := 0;
      Get_Index : Natural := 0;
      Count     : Natural := 0;
   end Bounded_Buffer;

 

   type Node;

 

   type Node_Access is access Node;

 

   type Node is record
      Value : Element_Type;
      Next  : Node_Access := null;
   end record;

 

   protected type Unbounded_Buffer is
      procedure Put(Item : in Element_Type);
      entry Get(Item : out Element_Type);
      function Size return Natural;
   private
      Head : Node_Access := null;
      Tail : Node_Access := null;
      Count : Natural := 0;
   end Unbounded_Buffer;

 

   Uninitialized_Data : exception;

 

   protected type Read_Any_Buffer is
      procedure Put(Item : in Element_Type);
      function Get return Element_Type;
      function Initialized return Boolean;
   private
      Value : Element_Type;
      Is_Valid : Boolean := False;
   end Read_Any_Buffer;

 

   protected type Read_New_Buffer is
      procedure Put(Item : in Element_Type);
      entry Get(Item : out Element_Type);
   private
      Value : Element_Type;
      Is_New : Boolean := False;
   end Read_New_Buffer;

 

   protected type Read_Write_New_Buffer is
      entry Put(Item : in Element_Type);
      entry Get(Item : out Element_Type);
   private
      Value : Element_Type;
      Is_New : Boolean := False;
   end Read_Write_New_Buffer;
end Buffers;

 

with Ada.Unchecked_Deallocation;

 

package body Buffers is
   protected body Bounded_Buffer is
      entry Put(Item : in Element_Type) when Size < Elements'Length is
      begin
         Elements(Put_Index) := Item;
         Put_Index := (Put_Index + 1) mod Elements'Length;
         Count := Count + 1;
      end Put;

 

      entry Get(Item : out Element_Type) when Size > 0 is
      begin
         Item := Elements(Get_Index);
         Get_Index := (Get_Index + 1) mod Elements'Length;
         Count := Count - 1;
      end Get;

 

      function Size return Natural is
      begin
         return Count;
      end Size;
   end Bounded_Buffer;

 

   protected body Unbounded_Buffer is
      procedure Put(Item : in Element_Type) is
         Temp_Node : Node_Access := new Node;
      begin
         Temp_Node.Value := Item;
         if Tail = null then
            Head := Temp_Node;
            Tail := Temp_Node;
         else
            Tail.Next := Temp_Node;
            Tail := Tail.Next;
         end if;
         Count := Count + 1;
      end Put;

 

      entry Get(Item : out Element_Type) when Head /= null is
         procedure Free is new Ada.Unchecked_Deallocation(Object => Node, Name => Node_Access);
         Temp : Node_Access;
      begin
         Item := Head.Value;
         Temp := Head;
         Head := Head.Next;
         if Head = null then
            Tail := null;
         end if;
         Free(Temp);
         Count := Count - 1;
      end Get;

 

      function Size return Natural is
      begin
         return Count;
      end Size;
   end Unbounded_Buffer;

 

   protected body Read_Any_Buffer is
      procedure Put(Item : in Element_Type) is
      begin
         Value := Item;
         Is_Valid := True;
      end Put;

 

      function Get return Element_Type is
      begin
         if not Is_Valid then
            raise Uninitialized_Data;
         end if;
         return Value;
      end Get;

 

      function Initialized return Boolean is
      begin
         return Is_Valid;
      end Initialized;
   end Read_Any_Buffer;

 

   protected body Read_New_Buffer is
      procedure Put(Item : in Element_Type) is
      begin
         Value := Item;
         Is_New := True;
      end Put;

 

      entry Get(Item : out Element_Type) when Is_New is
      begin
         Item := Value;
         Is_New := False;
      end Get;
   end Read_New_Buffer;

 

   protected body Read_Write_New_Buffer is
      entry Put(Item : in Element_Type) when not Is_New is
      begin
         Value := Item;
         Is_New := True;
      end Put;

 

      entry Get(Item : out Element_Type) when Is_New is
      begin
         Item := Value;
         Is_New := False;
      end Get;
   end Read_Write_New_Buffer;
end Buffers;

Ada 2012 Type Invariants and Predicates

Constrained Data Types and Subtypes

The Ada language has always had a limited ability to specify type invariants through the definition of range constraints on scalar data types. Along with giving the programmer the ability to specify range constraints, the Ada language has always provided some pre-defined subtypes of the Integer data type. For instance, the subtype Natural is defined as

subtype Natural is Integer range 0..Integer’Last;


This definition specifies that Natural is an integer with a constrained range of values, in this case the smallest valid Natural value is 0 and the highest is the maximum valid Integer value. Similarly, Ada provides the pre-defined subtype Positive, defined as

subtype Positive is Integer range 1..Integer’Last;


Type Integer is a signed data type, allowing both positive and negative values, but subtype Positive is an integer that can only contain a positive value.
While range specifications are very useful, they are also highly limited in their usefulness. Ada ranges must always be contiguous. This means that you cannot specify an integer data type of only even numbers, for instance. Even numbers are not contiguous.
More general type invariants are made available in the Ada 2012 language. There are two kinds of type invariants: static invariants and dynamic invariants. A static invariant is one that can be determined at compile time, such as a discrete list of valid values. Type invariants are contractual within a program.
Subtype predicates, on the other hand are more like value constraints, similar to a range constraint on a subtype. A dynamic predicate can be used, for instance, to define a subtype containing only even numbers.

subtype Even is Integer with Dynamic_Predicate => Even mod 2 = 0;


A  dynamic predicate allows the definition of a type that must be evaluated at run-time. In the case above every value in the subtype Even must satisfy the Dynamic_Predicate.

A Prime Number subtype

I decided to explore the possibility of creating a constrained subtype that only contains prime numbers. I wanted to understand how complex it would be to define such a type, and how inefficient such a subtype might be to use.


Table 1 Primes package specification
------------------------------------------------------------------

-- This package defines a subtype of integer                    --

-- All valid values in this subtype are prime numbers           --

------------------------------------------------------------------


package Primes is

   subtype Prime_Num is Integer with

   Dynamic_Predicate => Is_Prime(Prime_Num);

  

   -- Primality Test

   function Is_Prime(Item : Positive) return Boolean;

  

   -- Return the smallest prime number greater than the parameter

   function Next(Item : Positive) return Prime_Num

     with Pre => Item < Integer'Last;

  

   -- Return the greatest prime number less than the parameter

   function Previous(Item : Positive) return Prime_Num

     with Pre => Item > 2;

end Primes;

This was encouraging. Defining a prime number integer data type is very simple. The Dynamic_Predicate expression must evaluate to True or False, so I created a primality test returning a Boolean value. I added functions Next and Previous to allow iteration through the set of values in my Prime_Num type. Note that I called this a set of values and not a range of values. The set of prime numbers is very much discontinuous.
The package body for the Primes package reveals how simple the three functions actually are.

Table 2 Primes package body
with Ada.Numerics.Elementary_Functions; use Ada.Numerics.Elementary_Functions;


package body Primes is


   --------------

   -- Is_Prime --

   --------------


   function Is_Prime (Item : Positive) return Boolean is

      T : Positive := 2;

      Limit : Integer := Integer(Sqrt(Float(Item)));

   begin

      if Item = 2 then

         return True;

      end if;

      while T <= Limit loop

         if Item rem T = 0 then

            return False;

         end if;

         T := T + (if T = 2 then 1 else 2);

      end loop;

      return True;

   end Is_Prime;


   ----------

   -- Next --

   ----------


   function Next (Item : Positive) return Prime_Num is

      Value : Integer := Item + 1;

   begin

      while Value <= Integer'Last loop

         if Value in Prime_Num then

            return Value;

         end if;

         Value := Value + 1;

      end loop;

      return Item;

   end Next;


   --------------

   -- Previous --

   --------------


   function Previous (Item : Positive) return Prime_Num is

      Value : Integer := Item - 1;

   begin

      while Item >= 2 loop

         if Value in Prime_Num then

            return Value;

         end if;

         Value := Value - 1;

      end loop;

      return Item;

   end Previous;


end Primes;

The Is_Prime function is a slight modification of a naïve primality test. The function Next tests the values greater than the parameter passed to it and returns the first prime number it encounters. Notice that the test within the Next function is a simple type membership test. That membership test is based upon the Dynamic_Predicate specified for the subtype Prime_Num. In other words, it returns the result of the Is_Prime function. Similarly, the Previous function searches the integers less than the parameter for the first value that is in the Prime_Num subtype, and returns that value. If there is no prime number within the range of Integer that is greater than the parameter passed to Next, the function simply returns the parameter. A dynamic predicate is checked as a post-condition for every function returning a value of the type with that dynamic predicate. If the Next function returns a value that is not a prime number the function will raise an Assertion Error exception.
What then is the inefficiency associated with using a Dynamic_Predicate? As you can see, the function called within the Dynamic_Predicate is called twice in both the Next and Previous functions. One time within the body of the function and another time as a post-condition check of the function.
The following is a test program I created to measure the time required to execute the Next and Previous functions for the Prime_Num subtype.

Table 3 Primes test program
------------------------------------------------------------------

-- Primes Test                                                  --

------------------------------------------------------------------

with Ada.Text_Io; use Ada.Text_IO;

with Primes; use Primes;

with Ada.Calendar; use Ada.Calendar;


procedure Primes_Test is

   package Int_Io is new Ada.Text_IO.Integer_IO(Integer);

   use Int_IO;

   T_Start : Time;

   T_End   : Time;

   P       : Prime_Num;

begin

   Put_Line("Test the Next function to generate the next prime number");

   for Num in 1..20 loop

      Put(Item => Num, Width => 12);

      Put(" =>");

      T_Start := Clock;

      P := Next(Num);

      T_End := Clock;

      Put(Item => P, Width => 12);

      Put("   duration:" & Duration'Image(T_End - T_Start) &

         " seconds");

      New_Line;

   end loop;

   New_Line;

   Put_Line("Test the Previous function");

   for num in reverse Integer'Last - 20 .. Integer'Last loop

      Put(Item => Num, Width => 12);

      Put(" =>");

      T_Start := Clock;

      P := Previous(Num);

      T_End := Clock;

      Put(Item => P, Width => 12);

      Put("   duration:" & Duration'Image(T_End - T_Start) &

         " seconds");

      New_Line;

   end loop;

end Primes_Test;

As you can see, I instrumented the calls to Next and Previous so that I could capture the elapsed time spent in those calls.
For reference purposes, the results below were obtained using a system with an AMD A10-5700 APU operating at 3.40 GHz, using the Windows 10 operating system.

Test the Next function to generate the next prime number

           1 =>           2   duration: 0.000001414 seconds

           2 =>           3   duration: 0.000000283 seconds

           3 =>           5   duration: 0.000000566 seconds

           4 =>           5   duration: 0.000000283 seconds

           5 =>           7   duration: 0.000000283 seconds

           6 =>           7   duration: 0.000000283 seconds

           7 =>          11   duration: 0.000000566 seconds

           8 =>          11   duration: 0.000000566 seconds

           9 =>          11   duration: 0.000000283 seconds

          10 =>          11   duration: 0.000000282 seconds

          11 =>          13   duration: 0.000000283 seconds

          12 =>          13   duration: 0.000000283 seconds

          13 =>          17   duration: 0.000000282 seconds

          14 =>          17   duration: 0.000000566 seconds

          15 =>          17   duration: 0.000000283 seconds

          16 =>          17   duration: 0.000000566 seconds

          17 =>          19   duration: 0.000000282 seconds

          18 =>          19   duration: 0.000000283 seconds

          19 =>          23   duration: 0.000000849 seconds

          20 =>          23   duration: 0.000000566 seconds


Test the Previous function

  2147483647 =>  2147483629   duration: 0.000217217 seconds

  2147483646 =>  2147483629   duration: 0.000217217 seconds

  2147483645 =>  2147483629   duration: 0.000218913 seconds

  2147483644 =>  2147483629   duration: 0.000216934 seconds

  2147483643 =>  2147483629   duration: 0.000216652 seconds

  2147483642 =>  2147483629   duration: 0.000216652 seconds

  2147483641 =>  2147483629   duration: 0.000204772 seconds

  2147483640 =>  2147483629   duration: 0.000204489 seconds

  2147483639 =>  2147483629   duration: 0.000204490 seconds

  2147483638 =>  2147483629   duration: 0.000204772 seconds

  2147483637 =>  2147483629   duration: 0.000204206 seconds

  2147483636 =>  2147483629   duration: 0.000204207 seconds

  2147483635 =>  2147483629   duration: 0.000204206 seconds

  2147483634 =>  2147483629   duration: 0.000204490 seconds

  2147483633 =>  2147483629   duration: 0.000179317 seconds

  2147483632 =>  2147483629   duration: 0.000179317 seconds

  2147483631 =>  2147483629   duration: 0.000179317 seconds

  2147483630 =>  2147483629   duration: 0.000179034 seconds

  2147483629 =>  2147483587   duration: 0.000283683 seconds

  2147483628 =>  2147483587   duration: 0.000283965 seconds

  2147483627 =>  2147483587   duration: 0.000283683 seconds


As expected, it takes a lot longer to calculate the next or previous prime number for a very large number than it does for a small number.

Arduino Due/Segger J-Link EDU

I’ve been porting my Cortex-based RTS to Arduino Due, using the J-Link JTAG interface (because who can make an RTS without a debugger?). I’ve probably forgotten my initial problems with ST-LINK (an equivalent interface included for free on the STM32F4 board, supported by OSS software), but it seemed a much less trying experience than with Segger.

There are two things with J-Link GDB Server: first, it seems like a bad idea to keep the server alive after a GDB session ends, so start it with -singlerun; and second, you absolutely must issue monitor reset before running your program. If you don’t you’ll end up like I did, scratching my head for three days trying to understand why I was getting a HardFault at the SVC that FreeRTOS uses to kick tasking off.

Using Ada LZMA to compress and decompress LZMA files

Setup of Ada LZMA binding

First download the Ada LZMA binding at http://download.vacs.fr/ada-lzma/ada-lzma-1.0.0.tar.gz or at [email protected]:stcarrez/ada-lzma.git, configure, build and install the library with the next commands:

./configure
make
make install

After these steps, you are ready to use the binding and you can add the next line at begining of your GNAT project file:


with "lzma";

Import Declaration

To use the Ada LZMA packages, you will first import the following packages in your Ada source code:


with Lzma.Base;
with Lzma.Container;
with Lzma.Check;

LZMA Stream Declaration and Initialization

The liblzma library uses the lzma_stream type to hold and control the data for the lzma operations. The lzma_stream must be initialized at begining of the compression or decompression and must be kept until the compression or decompression is finished. To use it, you must declare the LZMA stream as follows:


Stream  : aliased Lzma.Base.lzma_stream := Lzma.Base.LZMA_STREAM_INIT;

Most of the liblzma function return a status value of by lzma_ret, you may declare a result variable like this:


Result : Lzma.Base.lzma_ret;

Initialization of the lzma_stream

After the lzma_stream is declared, you must configure it either for compression or for decompression.

Initialize for compression

To configure the lzma_stream for compression, you will use the lzma_easy_encode function. The Preset parameter controls the compression level. Higher values provide better compression but are slower and require more memory for the program.


Result := Lzma.Container.lzma_easy_encoder (Stream'Unchecked_Access, Lzam.Container.LZMA_PRESET_DEFAULT,
                                            Lzma.Check.LZMA_CHECK_CRC64);
if Result /= Lzma.Base.LZMA_OK then
  Ada.Text_IO.Put_Line ("Error initializing the encoder");
end if;
Initialize for decompression

For the decompression, you will use the lzma_stream_decoder:


Result := Lzma.Container.lzma_stream_decoder (Stream'Unchecked_Access,
                                              Long_Long_Integer'Last,
                                              Lzma.Container.LZMA_CONCATENATED);

Compress or decompress the data

The compression and decompression is done by the lzma_code function which is called several times until it returns LZMA_STREAM_END code. Setup the stream 'next_out', 'avail_out', 'next_in' and 'avail_in' and call the lzma_code operation with the action (Lzma.Base.LZMA_RUN or Lzma.Base.LZMA_FINISH):


Result := Lzma.Base.lzma_code (Stream'Unchecked_Access, Action);

Release the LZMA stream

Close the LZMA stream:


    Lzma.Base.lzma_end (Stream'Unchecked_Access);

Sources

To better understand and use the library, use the source Luke

Download

New releases for Ada Util, Ada EL, Ada Security, Ada Database Objects, Ada Server Faces, Dynamo

Ada Utility Library, Version 1.8.0

  • Added support for immediate flush and file appending to the file logger
  • Added support for RFC7231/RFC2616 date conversion
  • Improvement of configure and installation process with gprinstall (if available)
  • Added file system stat/fstat support
  • Use gcc intrinsics for atomic counters (Intel, Arm)

Download: http://download.vacs.fr/ada-util/ada-util-1.8.0.tar.gz
GitHub: https://github.com/stcarrez/ada-util

Ada EL, Version 1.6.0

  • Added support for thread local EL context
  • Improvement of configure and installation process with gprinstall (if available)

Download: http://download.vacs.fr/ada-el/ada-el-1.6.0.tar.gz
GitHub: https://github.com/stcarrez/ada-el

Ada Security, Version 1.1.2

  • Improvement of configure and installation process with gprinstall (if available)

Download: http://download.vacs.fr/ada-security/ada-security-1.1.2.tar.gz
GitHub: https://github.com/stcarrez/ada-security

Ada Database Objects, Version 1.1.0

  • Fix link issue on Fedora
  • Detect MariaDB as a replacement for MySQL
  • Improvement of configure and installation process with gprinstall (if available)

Download: http://download.vacs.fr/ada-ado/ada-ado-1.1.0.tar.gz
GitHub: https://github.com/stcarrez/ada-ado

Ada Server Faces, Version 1.1.0

  • New EL function util:formatDate
  • New request route mapping with support for URL component extraction and parameter injection in Ada beans
  • Improvement of configure, build and installation with gprinstall when available
  • Integrate jQuery 1.11.3 and jQuery UI 1.11.4
  • Integrate jQuery Chosen 1.4.2
  • New component <w:chosen> for the Chosen support
  • Added a servlet cache control filter

Download: http://download.vacs.fr/ada-asf/ada-asf-1.1.0.tar.gz
GitHub: https://github.com/stcarrez/ada-asf

Dynamo, Version 0.8.0

  • Support to generate Markdown documentation
  • Support to generate query Ada bean operations
  • Better code generation and support for UML Ada beans

Download: http://download.vacs.fr/dynamo/dynamo-0.8.0.tar.gz
GitHub: https://github.com/stcarrez/dynamo

Arduino Due and the Watchdog

A watchdogis used to detect when a system has gone off with the fairies; you have to reset the watchdog timer ("pat the watchdog") every so often or it takes some recovery action. In the case of the Arduino Due, with the ATSAM3X8E MCU, the recovery action is to reset the CPU.

In the ATSAM3X8E (and probably other Atmel MCUs, too), the watchdog timeout defaults to 16 seconds, and the default hardware state is that the watchdog is enabled! (the default in the Atmel Software Framework is to disable the watchdog unless you have defined CONF_BOARD_KEEP_WATCHDOG_AT_INIT).

Read more »

IO Expansion

I started checking out AdaCore's support library for STM32F4 boards, particularly to use I2C to talk to the PCF8547A IO expander (for possible use on the AdaPilot project).

I seem to have fritzed one or two of the pins on my STM32F429I-DISC0 board (now replaced by an updated version, STM32F429I-DISC1; that last character was a 0!); after some hair-pulling it turns out that one of said pins is used by the only externally-accessible I2C peripheral on the board; so, until the replacement arrives, here are some interesting facts about the PCF8547A.

Read more »

GCC 6.1 Ada Compiler From Scratch

We will do the following tasks:

  1. The binutils build and installation,
  2. The gcc build and installation,
  3. Setting up a default configuration for gprbuild,
  4. The XML/Ada build and installation,
  5. The gprbuild build and installation.

Pre-requisites

First, prepare three distinct directories for the sources, the build materials and the installation. Make sure you have more than 1.5G for the source directory, reserve 7.0G for the build directory and arround 1.5G for the installation directory.

To simplify the commands, define the following shell variables:

BUILD_DIR=<Path of build directory>
INSTALL_DIR=<Path of installation directory>
SRC_DIR=<Path of directory containing the extracted sources>

Also, check that:

  • You have a GNAT Ada compiler installed (at least a 4.9 I guess).
  • You have the gprbuild tool installed and configured for the Ada compiler.
  • You have libmpfr-dev, libgmp3-dev and libgmp-dev installed (otherwise this is far more complex).
  • You have some time and can wait for gcc's compilation (it took more than 2h for me).

Create the directories:

mkdir -p $BUILD_DIR
mkdir -p $INSTALL_DIR/bin
mkdir -p $SRC_DIR

And setup your PATH so that you will use the new binutils and gcc commands while building everything:

export PATH=$INSTALL_DIR/bin:/usr/bin:/bin

Binutils

Download binutils 2.26 and extract the tar.bz2 in the source directory $SRC_DIR.

cd $SRC_DIR
tar xf binutils-2.26.tar.bz2

Never build the binutils within their sources, you must use the $BUILD_DIR for that. Define the installation prefix and configure the binutils as this:

mkdir $BUILD_DIR/binutils
cd $BUILD_DIR/binutils
$SRC_DIR/binutils-2.26/configure --prefix=$INSTALL_DIR

And proceed with the build in the same directory:

make

Compilation is now complete you can install the package:

make install

Gcc

Download gcc 6.1.0 and extract the tar.bz2 in the source directory $SRC_DIR.

cd $SRC_DIR
tar xf gcc-6.1.0.tar.bz2

Again, don't build gcc within its sources and use the $BUILD_DIR directory. At this stage, it is important that your PATH environment variable uses the $INSTALL_DIR/bin first to make sure you will use the new installed binutils tools. You may add the --disable-bootstrap to speed up the build process.

mkdir $BUILD_DIR/gcc
cd $BUILD_DIR/gcc
$SRC_DIR/gcc-6.1.0/configure --prefix=$INSTALL_DIR --enable-languages=c,c++,ada

And proceed with the build in the same directory (go to the restaurant or drink a couple of beers while it builds):

make

Compilation is now complete you can install the package:

make install

The Ada compiler installation does not install two symbolic links which are required during the link phase of Ada libraries and programs. You must create them manually after the install step:

ln -s libgnarl-6.so $INSTALL_DIR/lib/gcc/x86_64-pc-linux-gnu/6.1.0/adalib/libgnarl-6.1.so
ln -s libgnat-6.so $INSTALL_DIR/lib/gcc/x86_64-pc-linux-gnu/6.1.0/adalib/libgnat-6.1.so

Setup the default.cgpr file

The gnatmake command has been deprecated and it is now using gprbuild internally. This means we need a version of gprbuild that uses the new compiler. One way to achieve that is by setting up a gprbuild configuration file:

cd $BUILD_DIR
gprconfig

Select the Ada and C compiler and then edit the default.cgpr file that was generated to change the Toolchain_Version, Runtime_Library_Dir, Runtime_Source_Dir, Driver to indicate the new gcc 6.1 installation paths (replace <INSTALL_DIR> with your installation directory):

configuration project Default is
   ...
   for Toolchain_Version     ("Ada") use "GNAT 6.1";
   for Runtime_Library_Dir   ("Ada") use "<INSTALL_DIR>/lib/gcc/x86_64-pc-linux-gnu/6.1.0//adalib/";
   for Runtime_Source_Dir    ("Ada") use "<INSTALL_DIR>/lib/gcc/x86_64-pc-linux-gnu/6.1.0//adainclude/";
   package Compiler is
      for Driver ("C") use "<INSTALL_DIR>/bin/gcc";
      for Driver ("Ada") use "<INSTALL_DIR>/bin/gcc";
      ...
   end Compiler;
   ...
end Default;

This is the tricky part because if you missed it you may end up using the old Ada compiler. Make sure the Runtime_Library_Dir and Runtime_Source_Dir are correct otherwise you'll have problems during builds. As far as I'm concerned, the gcc target triplet was also changed from x86_64-linux-gnu to x86_64-pc-linux-gnu. Hopefully, once we have built a new gprbuild everything will be easier. The next step is to build XML/Ada which is used by gprbuild.

XML/Ada

Download and extract the XML/Ada sources. Using the git repository works pretty well:

cd $BUILD_DIR
git clone https://github.com/AdaCore/xmlada.git xmlada

This time we must build within the sources. Before running the configure script, the default.cgpr file is installed so that the new Ada compiler is used:

cp $BUILD_DIR/default.cgpr $BUILD_DIR/xmlada/
cd $BUILD_DIR/xmlada
./configure --prefix=$INSTALL_DIR

And proceed with the build in the same directory:

make static shared

Compilation is now complete you can install the package:

make install-static install-relocatable

gprbuild

Get the gprbuild sources from the git repository:

cd $BUILD_DIR
git clone https://github.com/AdaCore/gprbuild.git gprbuild

Copy the default.cgpr file to the gprbuild source tree and run the configure script:

cp $BUILD_DIR/default.cgpr $BUILD_DIR/gprbuild/
cd $BUILD_DIR/gprbuild
./configure --prefix=$INSTALL_DIR

Setup the ADA_PROJECT_PATH environment variable to use the XML/Ada library that was just compiled. If you miss this step, you'll get a file dom.ali is incorrectly formatted error during the bind process.

export ADA_PROJECT_PATH=$INSTALL_DIR/lib/gnat

And proceed with the build in the same directory:

make

Compilation is now complete you can install the package:

make install

Using the compiler

Now you can remove the build directory to make some space. You'll not need the default.cgpr file anymore nor define the ADA_PROJECT_PATH environment variable (except for other needs). To use the new Ada compiler you only need to setup your PATH:

export PATH=$INSTALL_DIR/bin:/usr/bin:/bin

You're now ready to play and use the GCC 6.1 Ada Compiler.

❌