SIMPLE COMPONENTS
version 4.69
by Dmitry A. Kazakov

(mailbox@dmitry-kazakov.de)
[Home]

This library is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

As a special exception, if other files instantiate generics from this unit, or you link this unit with other files to produce an executable, this unit does not by itself cause the resulting executable to be covered by the GNU General Public License. This exception does not however invalidate any other reasons why the executable file might be covered by the GNU Public License.


The current version provides implementations of smart pointers, directed graphs, sets, maps, B-trees, stacks, tables, string editing, unbounded arrays, expression analyzers, lock-free data structures, synchronization primitives (events, race condition free pulse events, arrays of events, reentrant mutexes, deadlock-free arrays of mutexes), pseudo-random non-repeating numbers, symmetric encoding and decoding, IEEE 754 representations support, streams, persistent storage, multiple connections server/client designing tools and protocols implementations. It grew out of needs and does not pretend to be universal. Tables management and strings editing are described in separate documents see Tables and Strings edit. The library is kept conform to the Ada 95, Ada 2005, Ada 2012 language standards.

Quick reference

ASN.1       MQTT client and server/broker implementation    
B-trees   Multiple connection TCP servers
Chebyshev series   Mutexes
Cryptography   Objects and handles to
Doubly-linked webs and lists   ODBC bindings
Blackboards (lock-free)   OpenSSL bindings
ELV/eQ-3 MAX! client implementation   Parsers
Events (plain, pulse, array of)   Persistent objects and handles to
GNUTLS bindings   Persistent storage and handles to
Graphs (directed, weighted, acyclic, trees)   Pools
HTTP implementation   Sets and maps
FIFO (lock-free)   SMTP client implementation
IEEE 754   SQLite bindings
Inter-process communication   Stacks
Interfacing Julia language   Streams
Interfacing Pyhon language   Strings editing
JSON   Tables (maps of strings)
LDAP   Waveforms
MODBUS client implementation   Unbounded arrays
      ARM Intel
Download Simple Components for Ada Platform:   64- 32- 64- 32bit
Fedora packages fedora   precompiled and packaged using RPM     [Download page] [Download page] [Download page] [Download page]
CentOS packages CentOS   precompiled and packaged using RPM (you will need a prebuilt OpenSSL 1.1.1 package)       [Download page] [Download page]
Debian packages Debian   precompiled and packaged for dpkg   [Download page] [Download page] [Download page] [Download page]
Ubuntu packages Ubuntu      precompiled and packaged for dpkg   [Download page] [Download page] [Download page] [Download page]
Source distribution (any platform)   components_4_69.tgz (tar + gzip, Windows users may use WinZip)   [Download]

See also changes log.


[TOC][Next]

1. Objects and handles (smart pointers)

The objects and handles are designed to provide automatic garbage collection. The objects are created explicitly, but never explicitly destroyed. An application program usually should not directly access objects, using object handles (smart pointers) instead. As long as at least one handle to an object exists the object will not be destroyed. When the last handle disappears the object is automatically destroyed. The presented implementation is oriented on large and rather complex objects. Usually it has little sense to have pointers to small objects, having no identity. For such objects by-value semantics is often safer, easier to understand and more efficient. For this reason an object-oriented approach was chosen. The object type is considered a descendant of a limited controlled type which can be extended as necessary. Same handle type can be used for the whole class of descendant types. The proxy operations can be defined on handles which implementations may dispatch according to the actual type of the pointed object.

A specialization of objects is provided to support object's persistence. Such objects can be stored in an external persistent storage and then restored from there. The persistent storage interface itself is an object. This allows implementation of object serving as proxies of external objects permanently resident in an external storage.

[Back][TOC][Next]

1.1. Objects

The package Object provides the base type Entity for all objects:

type Entity is new
   Ada.Finalization.Limited_Controlled with
record
   Use_Count : Natural := 0;
end record;
type Entity_Ptr is access all Entity'Class;

It is a limited controlled type. The following operations are defined on it:

procedure Decrement_Count
          (  Object    : in out Entity;
             Use_Count : out Natural
          );

This procedure decreases object's reference count. The output parameter Use_Count is the updated value of the reference count to be used instead of Object.Use_Count in order to avoid race condition. It should never be used explicitly, except than in implementations of handles to objects.

function Equal
         (  Left  : Entity;
            Right : Entity'Class;
            Flag  : Boolean := False
         )  return Boolean;
function Less
         (  Left  : Entity;
            Right : Entity'Class;
            Flag  : Boolean := False
         )  return Boolean;

These functions are used to compare objects. The meaning of comparison is usually defined by the nature of the objects. However the main reason why comparison is defined, is to support ordered sets of objects, so any order is suitable. Thus the implementations of Equal and Less use storage addresses to get Entity objects ordered. They should be overridden if a more meaningful order of objects exists. Note that Ada does not fully support multiple dispatch. Therefore the operations are declared asymmetric. The second parameter is class-wide. If the operation is overridden, an implementation should dispatch on the second parameter to emulate true multiple dispatch. The parameter Flag indicates whether the function is called recursively. The following code fragment illustrates how to do it:

function Less
         (  Left  : A_New_Object_Type;
            Right : Object.Entity'Class;
            Flag  : Boolean := False
         )  return Boolean is
begin
   if (  Flag
      or else
         Right not in A_New_Object_Type'Class
      or else
         Right in A_New_Object_Type
      )
   then
      -- Implement it here
      ...
   else
      -- Dispatch on the second parameter
      return
         not (  Less (Right, Left, True)
             or else
                Equal (Right, Left, True)
             );
   end if;
end Less;

The idea is that a given overriding is responsible for implementation of Less if and only if Left :> Right, i.e. when Left is in the class of Right. The dispatching mechanism warranties that Left is in the type class, so if Right is of the same type or else does not belong to the type class, then Left :> Right. Otherwise, Right is used to re-dispatch and Flag is set to indicate that no more dispatch may happen. Observe, that if Left and Right are siblings and therefore neither of Left :> Right and Left <: Right is true, then Flag will stop the recursion.

If the implementation casts Right down to a known type, as it usually would do in other cases, then in the case of siblings, this would cause propagation of Constraint_Error out of Less or Equal. If this behavior is undesirable, another way to deal with comparison of siblings is to find the most specific common ancestor of both. In that case the code of Less might look as follows:

function Less
         (  Left  : A_New_Object_Type;
            Right : Object.Entity'Class;
            Flag  : Boolean := False
         )  return Boolean is
begin
   if (  Right not in A_New_Object_Type'Class
      or else
         Right in A_New_Object_Type
      )
   then
      -- Implement it here
      ...
   elsif Flag then
      -- Using Less of the most specific common ancestor,
      -- for example, the predefined Less:
      
return Object.Less (Object.Entity (Left), Right, True);
   else
      -- Dispatch on the second parameter
      return
         not (  Less (Right, Left, True)
             or else
                Equal (Right, Left, True)
             );
   end if;
end Less;

procedure Finalize (This : in out Entity);

This procedure is called upon object finalization. It raises Program_Error if the destroyed object is still in use. Note that any derived type shall call this procedure from its implementation of Finalize when it overrides Finalize.

procedure Increment_Count (Object : in out Entity);

This procedure increases object's reference count. It should never be used explicitly, except than in implementations of handles to objects.

procedure Initialize (Object : in out Entity);

This procedure is called upon object initialization. Any derived type shall call it from its implementation of.

procedure Release (Ptr : in out Entity_Ptr);

The object pointed by Ptr is deleted if its use count in 1. Otherwise the use count is decremented. Ptr becomes null if the object it points to is deleted. The procedure does nothing if Ptr is already null. It can be used for implementation of the smart pointers to Entity and its descendants.

1.1.1. Tasking

The package provides several implementations of Object:

[Back][TOC][Next]

1.2. Handles to objects

The generic child package Object.Handle defines the type Handle used to access objects of a given type:

generic
   type Object_Type (<>) is abstract new Entity with private;
   type Object_Type_Ptr is access Object_Type'Class;
package Object.Handle is
   
type Handle is new Ada.Finalization.Controlled with private;

The package has two generic parameters:

Handles can be assigned to copy a reference to the object. If a handle object is not initialized it is invalid. An invalid handle cannot be used to access objects, but it can be used in some comparisons, it can be copied and assigned. The constant Null_Handle defined in the package is a predefined invalid handle. The following operations are defined on a Handle:

procedure Finalize (Reference : in out Handle);

The destructor destroys the referenced object (if any) in case when the handle was the last one pointing the object.

procedure Invalidate (Reference : in out Handle);

This procedure detaches handle from the object (if any) it points to. The result handle cannot be used to access any object. The referenced object is destroyed if it was the last handle.

function Is_Valid (Reference : Handle) return Boolean;

This function checks whether a handle points to an object.

function Ptr (Reference : Handle) return Object_Type_Ptr;

This function is used to get a pointer to the object the handle points to. The pointer of to the object shall be used no longer the handle it was get from exists. A safe way to do it is to avoid declarations of any variables of the type Object_Type_Ptr.

function Ref (Thing : Object_Type_Ptr) return Handle;

This function is used to get a handle from a pointer to an object.

procedure Set (Reference : in out Handle; Thing : Object_Type_Ptr);

This procedure resets the handle Reference to a possibly another object. In the course of this operation the previously pointed object may be destroyed if Reference was the last handle pointing to it. It is safe when Thing is the object Reference already points to. When Thing is null, this procedure is equivalent to Invalidate.

function "<" (Left, Right : Handle) return Boolean;
function "<="(Left, Right : Handle) return Boolean;
function ">="(Left, Right : Handle) return Boolean;
function ">" (Left, Right : Handle) return Boolean;
function "=" (Left, Right : Handle) return Boolean;
function "="
        (  Left  : Handle;
           Right : access Object_Type'Class
        )  return Boolean;
function "="
        (  Left  : access Object_Type'Class;
           Right : Handle
        )  return Boolean;

Valid handles are comparable. The result of comparison is one of the objects they point to. Implementations of the comparisons use Less and Equal defined on Object_Type. If one of the parameters is invalid Contraint_Error is propagated for all functions except "=". For equality (and thus inequality) it is legal to compare with an invalid handle. The result of such comparison is true if and only if both handles are invalid. One of parameters in equality is allowed to be a pointer to an object.

[Back][TOC][Next]

1.3. An example of use

The usage of objects and handles is illustrated by the following simplified example of an implementation of dynamic strings: 

File test_my_string.ads:
with Object;

package Test_My_String is
   type My_String (Length : Natural) is
      new
Object.Entity with record
         Value : String (1..Length);
   end record;
   type My_String_Ptr is access My_String'Class;
end Test_My_String;

An instance of My_String keeps the string body. But a user should rather use handles to My_String, provided by the child package:

File test_my_string-handle.ads:
with Object.Handle;

package Test_My_String.Handle is
--
-- Though an instantiation of Object.Handle provides handles to
-- My_String, we would like to have some additional operations on
-- handles.
--

   package My_String_Handle is
      new Object.Handle (My_String, My_String_Ptr);
--
-- So we immediately derive from the obtained type. Note that no
-- additional components needed (with null record). 
--

   type My_Safe_String is
      new
My_String_Handle.Handle with null record;
--
-- Now define useful operations on string handles:
--

   function Create (Value : String) return My_Safe_String;
   function Value (Reference : My_Safe_String) return String;
--
--
 Note that Copy takes handle as an inout-parameter. It does not touch
-- the old object it just creates a new one and sets handle to point to
-- it. The old object is automatically destroyed if no more referenced. 
--

   procedure Copy
             (  Reference : in out My_Safe_String;
                New_Value : String
             );
   procedure Copy
             (  Reference : in out My_Safe_String;
                New_Value : My_Safe_String
             );
private
--
-- Note that Ref shall be overridden. This is a language requirement,
-- which ensures that the results are covariant. We make it private
-- because there is no need for a user to access it.
--

   function Ref (Pointer : My_String_Ptr) return My_Safe_String;

end Test_My_String.Handle;

This package defines the type My_Safe_String which can be used with less care about memory allocation and deallocation. A handle can be copied using the standard assignment. A new string object can be created from a string. The value it points to can be accessed using the function Value, etc. It is a good practice to provide Create returning a handle instead of a direct use of Ref on an existing object, because it prevents referring stack-allocated objects which could get out of scope before handles to them. Object.Finalize would notice that and raise Program_Error. An implementation of My_Safe_String might look like follows.

File test_my_string-handle.adb:
package body Test_My_String.Handle is

   function Create (Value : String) return My_Safe_String is
      Ptr : My_String_Ptr := new My_String (Value'Length);
   begin
      Ptr.Value := Value;
      return Ref (Ptr);
   end Create;

   function Value (Reference : My_Safe_String) return String is
   begin
      return Ptr (Reference).Value;
   end Value;

   procedure Copy
             (  Reference : in out My_Safe_String;
                New_Value : String
             )  is
   begin
      Reference := Create (New_Value);
   end Copy;

   procedure Copy
             (  Reference : in out My_Safe_String;
                New_Value : My_Safe_String
             )  is
   begin
      Reference := Create (Value (New_Value));
   end Copy;

   function Ref (Pointer : My_String_Ptr) return My_Safe_String is
   begin
      return (My_String_Handle.Ref (Pointer) with null record);
   end Ref;

end Test_My_String.Handle;

[Back][TOC][Next]

1.4. Bounded arrays of objects

The package Object.Handle.Generic_Bounded_Array defines the type Bounded_Array. An instance of Bounded_Array is a fixed size array of references to objects. It is same as an array of handles to objects but more efficient.

generic
   type Index_Type is (<>);
   type
Handle_Type is new Handle with private;
package
Object.Handle.Generic_Bounded_Array is ...

Here Index_Type is the type used to index the array elements. Handle_Type is any descendant of Handle including itself. The type Bounded_Array is defined in the package as:

type Bounded_Array (First, Last : Index_Type) is
   new
Ada.Finalization.Controlled with private;

The discriminants First and Last define the index range. The following operations are defined on Bounded_Array:

procedure Adjust (Container : in out Bounded_Array);

The assignment makes a copy of the array.

function Append
         (  Container : Bounded_Array;
            Element   : Object_Type_Ptr := null;
            Count     : Natural         := 1
         )  return Bounded_Array;
function Append
         (  Container : Bounded_Array;
            Element   : Handle_Type;
            Count     : Natural := 1
         )  return Bounded_Array;

These functions add Element Count times to the end of Container. The result will have the lower bound Container.First. Constraint_Error is propagated when the upper bound cannot be represented in Index_Type.

function Delete
         (  Container : Bounded_Array;
            From      : Index_Type;
            Count     : Natural := 1
         )  return Bounded_Array;

This function deletes Count elements from Container starting with the element From. When Count exceeds the number of elements in the array, the available elements are removed. The lower bound of the result is Container.First, except the case when all elements are removed. For an empty result, the lower bound is Index_Type'Succ (Index_Type'First). Constraint_Error is propagated when the result should be empty, but Index_Type has less than two values. It is also propagated when From is not in Container.

procedure Finalize (Container : in out Bounded_Array);

The destructor may delete some objects referenced by the array.

procedure Fill
          (  Container : in out Bounded_Array;
             From      : Index_Type;
             To        : Index_Type;
             Element   : Object_Type_Ptr := null
          );
procedure Fill
          (  Container : in out Bounded_Array;
             From      : Index_Type;
             To        : Index_Type;
             Element   : Handle_Type
          );

These procedures are used to put in / replace a range of array elements. The range From..To is filled with Element. Nothing happens if From > To. Otherwise Constraint_Error is propagated when From..To is not in Container.First..Constainer.Last.

function Get
         (  Container : Bounded_Array;
            Index     : Index_Type
         )  return Object_Type_Ptr;

This function returns either a pointer to an object or null.

function Get
         (  Container : Bounded_Array;
            From      : Index_Type;
            To        : Index_Type
         )  return Bounded_Array;

This function returns a slice of Container. The lower index of the slice is From, the upper index is To. Constraint_Error is propagated when From..To is not empty and does not belong to the range First..Last of Container.

function Prepend
         (  Container : Bounded_Array;
            Element   : Object_Type_Ptr := null;
            Count     : Natural         := 1
         )  return Bounded_Array;
function Prepend
         (  Container : Bounded_Array;
            Element   : Handle_Type;
            Count     : Natural := 1
         )  return Bounded_Array;

These functions add Element Count times in front of Container. The result will have the upper bound Container.Last. Constraint_Error is propagated when the upper bound cannot be represented in Index_Type.

procedure Put
          (  Container : in out Bounded_Array;
             Index     : Index_Type;
             Element   : Object_Type_Ptr
          );
procedure Put
          (  Container : in out Bounded_Array;
             Index     : Index_Type;
             Element   : Handle_Type
          );

These procedures are used to put in / replace an array element using its index. Constraint_Error is propagated when Index is illegal.

procedure Put
          (  Container : in out Bounded_Array;
             From      : Index_Type;
             To        : Index_Type;
             Elements  : Bounded_Array
          );

This procedures replaces the slice From..To of Container with Elements. Container and Elements can be the same object. Else if Elements is shorter than the slice, the rightmost elements of the slice are replaced with invalid handles. When Elements is longer, then its rightmost elements are ignored. The operation is void when From..To is empty. Constraint_Error is propagated when From..To is not empty and does not belong to the range First..Last of Container.

function Ref
         (  Container : Bounded_Array;
            Index     : Index_Type
         )  return Handle_Type;
This function returns a valid handle to an object. Otherwise Constraint_Error is propagated.
function "&" (Left, Right : Bounded_Array) return Bounded_Array;

This function returns a concatenation of two arrays. If Right is empty, the result Left, else if Left is empty, the result is Right. Otherwise, the lower bound of the result is Index_Type'First.

Empty : constant Bounded_Array;

Empty array constant.

[Back][TOC][Next]

1.5. Unbounded arrays of objects

The package Object.Handle.Generic_Unbounded_Array defines the type Unbounded_Array. An instance of Unbounded_Array is an unbounded array of references to objects. The package has same functionality as an instance of Generic_Unbounded_Array with Handle as Object_Type, but it is more efficient.

generic
   type Index_Type is (<>);
   type
Handle_Type is new Handle with private;
   Minimal_Size : Positive := 64;
   Increment    : Natural  := 50;
package Object.Handle.Generic_Unbounded_Array is ...

Here:

The type is declared as:

type Unbounded_Array is new Ada.Finalization.Controlled with private;

The following operations are defined on Unbounded_Array:

procedure Adjust (Container : in out Unbounded_Array);
The assignment does not make a copy of the array. It just increments an internal use count. The array will be copied only when a destructive operation is applied.

procedure Erase (Container : in out Unbounded_Array);

This procedure removes all elements from Container making it empty. The objects referenced only by Container will be deleted.

procedure Finalize (Container : in out Unbounded_Array);

The destructor may delete some objects referenced by the array.

function First
         (  Container : Unbounded_Array;
         )  return Index_Type;

This function returns the current lower bound of the array. Constraint_Error is propagated when the array is empty.

function Get
         (  Container : Unbounded_Array;
            Index     : Index_Type
         )  return Object_Type_Ptr;

This function returns either a pointer to an object or null.

function Last
         (  Container : Unbounded_Array;
         )  return Index_Type;

This function returns the current upper bound of the array. Constraint_Error is propagated when the array is empty.

procedure Put
          (  Container : in out Unbounded_Array;
             Index     : Index_Type;
             Element   : Object_Type_Ptr
          );
procedure Put
          (  Container : in out Unbounded_Array;
             Index     : Index_Type;
             Element   : Handle_Type
          );

These procedures are used to put in / replace an array element using its index. The array is automatically expanded as necessary. It never happens if Element is null or an invalid handle.

function Ref
         (  Container : Unbounded_Array;
            Index     : Index_Type
         )  return Handle_Type;
This function returns a valid handle to an object. Otherwise Constraint_Error is propagated.

[Back][TOC][Next]

1.6. Unbounded sets of objects

The package Object.Handle.Generic_Set defines the type Set. An instance of Generic_Set is a set of references to objects. The package has same functionality as an instance of Generic_Set with Handle as Object_Type, but it is more efficient. It has the following generic parameters:

generic
   Minimal_Size : Positive := 64;
   Increment    : Natural  := 50;
package Object.Handle.Generic_Set is ...

Here:

The type Set is declared as:

type Set is new Ada.Finalization.Controlled with private;

The following operations are defined on Set:

procedure Add (Container : in out Set; Item  : Handle);
procedure
Add (Container : in out Set; Item  : Object_Type_Ptr);
procedure
Add (Container : in out Set; Items : Set);

These procedures are used to add an object to a Set or all items of one set to another. The parameter Item can be either a handle or a pointer to the object. Nothing happens if an item is already in the set or pointer is an invalid handle or null.

procedure Adjust (Container : in out Set);

The assignment does not make a copy of the Container. It just increments an internal use count of the set body. A set will be physically copied only when a destructive operation is applied to it.

function Create return Set;

This function returns an empty set.

procedure Erase (Container : in out Set);

This procedure removes all objects from the set. The objects referenced only by Container will be deleted.

procedure Finalize (Container : in out Set);

The destructor may delete some objects referenced by Container.

function Find (Container : Set; Item : Handle)
   return Integer;
function
Find (Container : Set; Item : Object_Type'Class)
   return Integer;
function Find (Container : Set; Item : Object_Type_Ptr)
   return Integer;

This function is used to Item in the set Container. The result is either a positive index of the found item or a negated index of the place where the item should be if it were in the set.

function Get (Container : Set; Index : Positive)
   return Object_Type_Ptr;

This function is used to get an item of the set Container using a positive index. The result is a pointer to the object. It is valid as long as the object is in the set. See also Ref which represents a safer way of accessing the set items. Constraint_Error is propagated if Index is wrong.

function Get_Size (Container : Set) return Natural;

This function returns the number of items in the set.

function Is_Empty (Container : Set) return Boolean;

True is returned if Container is empty.

function Is_In (Container : Set; Item : Handle)
   return Boolean;
function
Is_In (Container : Set; Item : Object_Type'Class)
   return Boolean;
function Is_In (Container : Set; Item : Object_Type_Ptr)
   return Boolean;

True is returned if Item is in Container. Item can be either a pointer to the object, a handle to it or the object itself. The result is always false when Item is invalid or null.

function Ref (Container : Set; Index : Positive) return Handle;

This function is used to get an item of the set Container using a positive index. The result is a handle to the object. Constraint_Error is propagated if Index is wrong.

procedure Remove (Container : in out Set; Index : Positive);
procedure Remove (Container : in out Set; Item  : Handle);
procedure
Remove (Container : in out Set; Item  : Object_Type'Class);
procedure Remove (Container : in out Set; Item  : Object_Type_Ptr);
procedure Remove (Container : in out Set; Items : Set);

These procedures are used to remove items from the set Container. An item can be removed either by its index, or explicitly by a pointer, object or handle to it, or else by specifying a set of items to be removed. If a particular item is not in the set, then nothing happens. Also nothing happens if a handle is illegal or pointer is null. Constraint_Error is propagated when item index is wrong.

function "and" (Left, Right : Set) return Set;
function "or"  (Left, Right : Set) return Set;
function "xor" (Left, Right : Set) return Set;

These functions are conventional set operations - intersection, union, difference. Difference is defined as a set which items are only in one of the sets Left and Right.

function "=" (Left, Right : Set) return Boolean;

True is returned if both sets contain same items.

[Back][TOC][Next]

1.7. Universal sets of objects

The packages Object.Handle.Generic_Handle_Set resembles Object.Handle.Generic_Set, but it is more universal. It allows to specify a user-defined types both for the object handles and for the weak references to objects (usually pointers). It has the following generic parameters:

generic
   type
Handle_Type is new Handle with private;
   type
Object_Ptr_Type is private;
  
Null_Object_Ptr : Object_Ptr_Type;
   with function
Ptr (Object : Handle_Type) return Object_Ptr_Type is <>;
   with function Ref (Object : Object_Ptr_Type) return Handle_Type is <>;
   with function To_Object_Ptr (Object : Object_Ptr_Type) return Object_Type_Ptr is <>;
   with function
"<" (Left, Right : Object_Ptr_Type) return Boolean is <>;
   with function
"=" (Left, Right : Object_Ptr_Type) return Boolean is <>;
   Minimal_Size : Positive := 64;
   Increment    : Natural  := 50;
package Object.Handle.Generic_Handle_Set is ...

Here:

In other aspects both packages are identical. The interface subprograms described below are similar in both. The Handle should be read Handle_Type when Object.Handle.Generic_Handle_Set is considered.

The type Set is declared as:

type Set is new Ada.Finalization.Controlled with private;

The following operations are defined on Set:

procedure Add (Container : in out Set; Item  : Handle_Type);
procedure
Add (Container : in out Set; Item  : Object_Ptr_Type);
procedure
Add (Container : in out Set; Items : Set);

These procedures are used to add an object to a set or all items of one set to another. The parameter Item can be either a handle or a pointer to the object. Nothing happens if an item is already in the set or pointer is an invalid handle or null.

procedure Adjust (Container : in out Set);

The assignment does not make a copy of the Container. It just increments an internal use count of the set body. A set will be physicaly copied only when a destructive operation is applied to it.

function Create return Set;

This function returns an empty set.

procedure Erase (Container : in out Set);

This procedure removes all objects from the set. The objects referenced only by Container will be deleted.

procedure Finalize (Container : in out Set);

The destructor may delete some objects referenced by Container.

function Find (Container : Set; Item : Handle_Type)
   return Integer;
function Find (Container : Set; Item : Object_Ptr_Type)
   return Integer;

This function is used to Item in the set Container. The result is either a positive index of the found item or a negated index of the place where the item should be if it were in the set.

function Get (Container : Set; Index : Positive)
   return Object_Ptr_Type;

This function is used to get an item of the set Container using a positive index. The result is a pointer to the object. It is valid as long as the object is in the set. See also Ref which represents a safer way of accessing the set items. Constraint_Error is propagated if Index is wrong.

function Get_Size (Container : Set) return Natural;

This function returns the number of items in the set.

function Is_Empty (Container : Set) return Boolean;

True is returned if Container is empty.

function Is_In (Container : Set; Item : Handle_Type)
   return Boolean;
function Is_In (Container : Set; Item : Object_Ptr_Type)
   return Boolean;

True is returned if Item is in Container. Item can be either a pointer to an object or a handle to it. The result is always false when Item is invalid or null.

function Ref (Container : Set; Index : Positive) return Handle_Type;

This function is used to get an item of the set Container using a positive index. The result is a handle to the object. Constraint_Error is propagated if Index is wrong.

procedure Remove (Container : in out Set; Index : Positive);
procedure Remove (Container : in out Set; Item  : Handle_Type);
procedure
Remove (Container : in out Set; Item  : Object_Ptr_Type);
procedure Remove (Container : in out Set; Items : Set);

These procedures are used to remove items from the set Container. An item can be removed either by its index, or explicitly by a pointer or handle to it, or else by specifying a set of items to be removed. If a particular item is not in the set, then nothing happens. Also nothing happens if a handle is illegal or pointer is null. Constraint_Error is propagated when item index is wrong.

function "and" (Left, Right : Set) return Set;
function "or"  (Left, Right : Set) return Set;
function "xor" (Left, Right : Set) return Set;

These functions are conventional set operations - intersection, union, difference. Difference is defined as a set which items are only in one of the sets Left and Right.

function "=" (Left, Right : Set) return Boolean;

The function returns true is returned if both sets contain same items.


[Back][TOC][Next]

2. Persistency

[Back][TOC][Next]

2.1. Persistent objects

A persistent object is one stored in an external storage independent on the application that originally created it. A persistent object can be restored from the external storage in a fully functional state in the same or other application. The provided implementation of persistent objects was designed with the following goals in mind:

Like other objects, persistent ones are normally accessed through handles.

2.1.1. Types

The package Object.Archived defines the type Deposit serving as the abstract base type for all persistent objects:

type Deposit is abstract new Entity with private;
type Deposit_Ptr is access Deposit'Class;

A type derived from d from Deposit should:

Objects may depend on other objects, but these dependencies may not be circular. Store and Restore provide forth and back string conversions. String was chosen instead of Stream_Element_Array to make it portable across different systems.

Storing an object:

  1. Get_Referents is called. Each object it refers is archived first. The order of the objects in the list is important and has to be preserved;
  2. Get_Class is called and its result is archived;
  3. Store is called and its result is finally archived.

Restoring an object:

  1. A list of objects the archived object depends on is built, the objects are restored as necessary;
  2. The object's class string is obtained;
  3. Restore is finally called with these parameters. The class is used to select an appropriate Restore. This is equivalent to dispatching according to the class. The list of available classes and their Restore procedures is formed by calls to Register.

The type Backward_Link is used when it is necessary to monitor deletion of an object.

type Backward_Link is abstract new Entity with private;
type Backward_Link_Ptr is access Backward_Link'Class;

Reference counting is used to prevent deletion of a Deposit object, when it is in use. Such objects are referenced through handles. These are direct links to the object, also known as strong references. But sometimes it is necessary to break the dependency of one object from another to delete the latter. For this the former object may get a notification about a desire to delete a referent. Upon this notification it can invalidate the handle to the referent and so allow the collector to delete it. A notification object is derived from Backward_Link, which represent a backward link from a referred object to a dependent one. Each Deposit object maintains a list of its backward links, also called weak references. Typically an external storage connection object tracks all persistent objects which are in the memory at the moment. Usually it has an index of such memory resident objects. A record of this index has a handle to a specialized descendant of Backward_Link. So when an object is no more in use and so the last handle to it disappears, the object is automatically destroyed. In the course of this operation the storage connection object becomes a notification via call to Destroyed. At this point the object being destroyed can be stored and then removed from the external storage index of memory resident objects.

type Deposit_Container is abstract
   new
Ada.Finalization.Controlled with private;

The type Deposit_Container is an abstract specialized container for Deposit objects. The container operates as a container of handles. That is when an object is put into it, then the object will not be deleted until it is in. Physically a reference to the object is placed into the container. Deposit_Container objects are used upon object storing and restoring to keep the list of things the object depends on. Deposit_Container is not limited so it can be copied when necessary. The child packages Object.Archived.Sets and Object.Archived.Lists provide unordered (set) and ordered (list) implementations of Deposit_Container.

2.1.2. Operations on objects

procedure Close (Object : in out Deposit'Class);

This class-wide procedure is called before finalization of a persistent object. It cleans the list of backward links. So it plays the role of a class-wide destructor. Finalize should always call it. For example, if the derived type is a descendant of Deposit overriding Finalize, then the implementation should look like:

procedure Finalize (Object : in out Derived) is
begin
  
Close (Object);
   ... -- finalization of Derived
   Finalize (Deposit (Object));
end Finalize;

It is safe to call it multiple times, though it is essential to call it before any vital object data get finalized. So Finalization of a type derived from Derived may call Close as well. Note that in Ada Finalize is called prior finalization of any object's components. So it is safe to use them. However, keep in mind that task components (if any) are though not yet finalized, but completed before Finalize, thus neither Store nor Get_Referents may communicate with task components of the object.

procedure Create
          (  Source  : String;
             Pointer : in out Integer;
             Class   : String;
             List    : Deposit_Container'Class;
             Object  : out Deposit_Ptr
          );

This procedure calls Restore for Class simulating a dispatching call. Name_Error is propagated if Class is not a registered object class. The string Source contains object description to be restored starting from the character Source (Pointer). Pointer  is advanced to the first object following from the used ones. The parameter Object accepts a pointer to the newly created object.

Exceptions
Data_Error Syntax error
End_Error Nothing matched
Layout_Error The value of Pointer is not in the range Source'First..Source'Last+1 
Name_Error Class is not a registered class
Use_Error Insufficient dependencies list

procedure Delete (Object : in out Deposit'Class);

This procedure is used when Object is being deleted. On each item in the Object's obituary notices delivery list, Delete is called. This has the effect that some references to Object may disappear and so the object will be collected. Note that a call to Delete does not guaranty Object's deletion, because some references to it, may still be present. It is safe to add new backward links to the Object's notification list from Delete, because the items are appended at the end of the delivery list. This also means that they will receive a Deleted callback in the course of the same notification. It is also safe to remove backward links from the list. Though Object's deletion is not guaranteed it might happen. So to prevent undefined behavior a caller should hold a handle to Object when it calls to Delete.

procedure Finalize (Object : in out Deposit);

Upon finalization backward links list is cleaned. All interested parties receive a notification via call to Destroyed. A derived type implementation have to call Finalize as well as Close.

procedure Free (Object : in out Deposit_Ptr);

This procedure is used to delete manually created objects. It is never called for existing objects, only for improperly constructed ones from an implementation of Restore.

function Get_Class (Object : Deposit) return String is abstract;

This function returns the class of Object. The class is a string uniquely describing the object's type. It is analogous to external type tag representation. Though, different types of objects may share same class if necessary.

procedure Get_Referents
          (  Object    : Deposit;
             Container : in out Deposit_Container'Class
          );

This procedure adds objects referenced from Object to Container objects. Only immediately viewed objects are stored there. No deep search has to be made to detect all objects. Objects shall not depend recursively. The default implementation does nothing, which behavior corresponds to an independent object. An implementation may raise Use_Error on a wrong object. See also notes about Close.

function Is_Modified (Object : Deposit)
   return
Boolean is abstract;

This function is used to check if Object's state was changed. Persistent objects serving as proxies to a persistent storage will require synchronization if this function returns true. An implementation of a mutable object would normally have a Boolean flag to be set by any destructive operation or new object creation.

procedure Reset_Modified (Object : in out Deposit) is abstract;

This procedure is used to reset Object's state modification flag. It is called immediately after synchronization the object with the persistent storage.

type Restore is access procedure
   
 (  Source  : String;
        Pointer : in out Integer;
        Class   : String;
        List    : Deposit_Container'Class;
        Object  : out Deposit_Ptr
     );

This procedure creates a new object from its string representation. It parses Source starting from Source (Pointer). Pointer is then advanced to the first character following the object's description in the string. The procedure has to be dispatching depending on the object's class, which is impossible in Ada. For this reason it is defined as an access to procedure type. Each object class has to define such a function and register it (see Register_Class). The parameter Class contains the actual object class according to which dispatch to an implementation of Restore was made. The parameter List contains the references to the objects the restored object depends on. The order of the objects in the list is same as one returned in Get_Referents. The result is a newly allocated object pointed by the Object parameter. An implementation may raise the following exceptions to indicate errors:

Exceptions
Data_Error Syntax error
End_Error Nothing matched
Layout_Error The value of Pointer is not in the range Source'First..Source'Last+1 
Use_Error Insufficient dependencies list

procedure Store
          (  Destination : in out String;
             Pointer     : in out Integer;
             Object      : Deposit
          )  is abstract;

An implementation places string describing Object is into Destination starting from the position specified by Pointer. Pointer is then advanced to the next position following the output. Layout_Error is propagated when Pointer not in Source'First..Source'Last + 1 or there is no room for output. Use_Error can be raised when Object is wrong. See also notes about Close.

2.1.3. Operations on backward links to objects

procedure Attach
          (  Link   : Backward_Link_Ptr;
             Object : Deposit_Ptr
          );

This procedure places Link at the end of Object's delivery list. If it is already in another list then it is removed from there first. Nothing happens if Object is null.

procedure Deleted
          (  Link  : in out Backward_Link;
             Temps : in out Deposit_Container'Class
          )  is abstract;

This procedure is used when an object is requested to be deleted. Normally Deleted is called as a result of object deletion request via call to Delete. The parameter Temps is the list of temporal objects the implementation might create. For example, some objects might be created to be notified within the course of the operation performed by the caller. Note that the caller should hold a handle to Link, to allow the callee to undertake actions which would otherwise lead to Link deletion. Note also that object's finalization does not cause a call to Delete it calls Destroyed instead.

procedure Destroyed (Link : in out Backward_Link) is abstract;

This procedure is used when an object is finally destroyed, but is still fully operable. Thus an implementation of Destroyed may safely access the object referred by Link. It may for example synchronize the object with the external storage or remove the object from the index cache etc. The caller should hold a handle to Link.

procedure Detach (Link : in out Backward_Link);

This procedure removes Link from object's delivery list, if any.

procedure Finalize (Link : in out Backward_Link);

This procedure should be called by a derived type if overridden. Link is removed for object's delivery list if any.

function Self (Link : Backward_Link) return Backward_Link_Ptr;

This function returns a pointer to the link object (to Link itself). Constraint_Error is propagated when Link is not bound to any object.

function This (Link : Backward_Linkont color="#0000FF">return Deposit_Ptr;

This function returns a pointer to the target of Link. Constraint_Error is propagated when Link is not bound to any object.

The package Backward_Link_Handles provides handles to Backward_Link objects.

The child package Backward_Link_Handles.Sets provides sets of handles to Backward_Link object.

2.1.4. Operations on containers

procedure Add
          (  Container : in out Deposit_Container;
             Object    : Deposit_Ptr;
             Backward  : Boolean := False
          )  is abstract;

This procedure puts a reference to Object into Container. The implementation should ensure that Object will not be destroyed until it is in. The parameter Backward, when true indicates a backward link. Backward links are used when the dependent object associated with the container can survive deletion of Object. It is an optional parameter which may be ignored by some implementations. When it is supported, then marking an Object as a backward link should override the effect of any placing the same object as a direct link (with Backward = false). Nothing happens if Object is null.

procedure Erase (Container : in out Deposit_Container) is abstract;

This procedure removes all objects from Container.

function Get
         (  Container : Deposit_Container;
            Index     : Positive
         )  return Deposit_Ptr is abstract;

This function is used to enumerate the objects in a container Objects indices start with 1. Contraint_Error is propagated when Index is wrong.

function Get_Size (Container : Deposit_Container)
   return
Natural is abstract;

This function returns the number of objects in Container, i.e. the largest possible index allowed in Get. 0 is returned when the container is empty. Note that the objects in a container need not to be all different. This depends on the container implementation.

function Is_Backward
         (  Container : Deposit_Container;
            Object    : Deposit_Ptr
         )  return Boolean is abstract;

The result of this function is true if a backward link is used for Object in Container. Constraint_Error is propagated when Object is not in Container. Use_Error is propagated when the container implementation does not distinguish direct and backward links.

function Is_Empty (Container : Deposit_Container'Class)
   return
Boolean;

This function returns true if Container is empty. It is class-wide.

function Is_In
         (  Container : Deposit_Container;
            Object    : Deposit_Ptr
         )  return Boolean is abstract;

This function returns true if Object is in Container. Note that null cannot be in any container.

2.1.5. Registering classes of objects

function Is_Registered (Class : String) return Boolean;

This function returns true if there is a class of objects registered under the name Class.

procedure Register_Class
          (  Class       : String;
             Constructor : Restore
          );

This procedure is used to register each new class of objects. It is analogous to creating a dispatching table. It is necessary to register a class to make Restore functions working. Nothing happens if the class is already registered and has same constructor. Name_Error is propagated when class is registered with a different constructor.

2.1.6. Sets of persistent objects

The package Object.Archived.Sets provides an implementation of Deposit_Container. The type Deposit_Set is derived there:

type Deposit_Set is new Deposit_Container with private;

Sets do not distinguish multiple insertion of an object. they also ignore the Backward parameter of Add. So Is_Backward will raise Use_Error. Additionally to the predefined operations, Deposit_Set provides standard set-operations:

procedure Remove
          (  Container : in out Deposit_Set;
             Object    : Deposit_Ptr
          );

This procedure removes Object from Container. Nothing happens if it is null or not in.

function "and" (Left, Right : Deposit_Set) return Deposit_Set;
function "or"  (Left, Right : Deposit_Set) return Deposit_Set;
function "xor" (Left, Right : Deposit_Set) return Deposit_Set;

These functions are conventional set operations - intersection, union, difference. Difference is defined as a set which items are only in one of the sets Left and Right.

function "=" (Left, Right : Deposit_Set) return Boolean;

true is returned if both sets contain same items.

2.1.7. Lists of persistent objects

The package Object.Archived.Lists provides an implementation of Deposit_Container. The type Deposit_List is derived there as:

type Deposit_List is new Deposit_Container with private;

All objects in the list are enumerated from 1. The same object can occupy several places in the list. In the external storage Deposit_List can be stored as a set of objects, where objects do not repeat, followed by a list of values identifying the objects in the set. Additionally to the predefined operations, Deposit_List provides:

function Get_Total (Container : Deposit_List) return Natural;

This function returns the number of distinct objects in Container. This value is less or equal to the one returned by Get_Size.

function Is_First
         (  Container : Deposit_List;
            Index     : Positive
         )  return Boolean;

This function returns true if Index is the least index of the object it specifies. I.e. the least index of the object returned by Get (Container, Index). Constraint_Error is propagated if Index is wrong.

2.1.8. Referent objects enumeration

The package Object.Archived.Iterators provides an abstract iterator of references:

type References_Iterator
     (  Referents : access Deposit_Container'Class
     )  is new Ada.Finalization.Limited_Controlled with private;

The type References_Iterator can be used directly or be extended. It provides the following operations:

procedure Enumerate
          (  Iterator : in out References_Iterator'Class;
             Object   : Deposit'Class
          );

This class-wide procedure is called to enumerate references of Object. This same procedure is used for both starting the process and continuing it for each found reference. Enumerate calls Get_Referents for Object and places all found objects which Object depends on into Iterator.Referents.all. A found object is placed only once which is detected by looking into Iterator.Referents.all. The object itself is not put there. After completion the caller may inspect Iterator.Referents.all for any found objects.

procedure On_Each
          (  Iterator : in out References_Iterator;
             Referent : Deposit_Ptr
          );

This procedure can be overridden. It is called by Enumerate each time a new object is found. It may raise an exception to stop the iteration process. This exception will then propagate out of Enumerate.

[Back][TOC][Next]

2.2. Handles to persistent objects

Persistent objects are subject of garbage collection. The recommended way to access them is through handles, which prevents premature destruction of objects in use. Handles can be aggregated into other objects to express object dependencies. Note that circular dependencies shall be avoided. The best way to do it is to design object in a way that would exclude any possibility of circular dependencies. If that is not possible, then Is_Dependent should be used to check dependencies at run time. The generic package Object.Archived.Handle defines the type Handle used to reference persistent object. It is derived from Handle obtained by an instantiation of Object.Handle:

generic
   type
Object_Type (<>) is abstract new Deposit with private;
   type
Object_Ptr_Type is access Object_Type'Class;
package
Handles is new Object.Handle (Deposit, Deposit_Ptr);
   type
Handle is new Handles.Handle with null record;

The formal parameters of the package are:

There is a ready-to use instantiation of Object.Archived.Handle with Deposit and Deposit_Ptr as the actual parameters: Deposit_Handles.

The package Object.Archived.Handle defines the following operations on Handle:

procedure Add
          (  Container : in out Deposit_Container;
             Object    : Handle;
             Backward  : Boolean := False
          )  is abstract;

This procedure puts Object into Container. The parameter Backward, when true indicates a backward link. Backward links are used when the dependent object associated with the container can survive deletion of Object. Constraint_Error is propagated when Object is an invalid handle.

procedure Delete (Object : in out Handle);

This procedure requests deletion of the object pointed by the handle Object. As the result of the operation Object becomes an invalid handle. The object itself is deleted if possible. Nothing happens if Object is not a valid handle.

function Get_Class (Object : Handle) return String;

This function returns the class of Object. The class is a string uniquely describing the object's type. It is analogous to an external type tag representation. Though, different types of objects may have same class if necessary.

procedure Get_References
          (  Object    : Handle;
             Container : in out Deposit_Container'Class
          );

This procedure adds to Container references to all objects the object specified by the handle Object depends on. No objects added if Object is an invalid handle.

procedure Invalidate (Object : in out Handle);

This procedure detaches handle from the object (if any) it points to. The result handle cannot be used to access any object. The referenced object is destroyed if it was the last handle.

function Is_Backward
         (  Container : Deposit_Container'Class;
            Object    : Handle
         )  return Boolean;

This function returns true if a backward link used for Object in Container. Contstraint_Error is propagated when Object is not in Container or invalid handle. Use_Error does when Container does not distinguish direct and backward links.

function Is_Dependent
         (  Dependant : Handle;
            Referent  : Handle
         )  return Boolean;
function
Is_Dependent
         (  Dependant : Handle;
            Referents : Deposit_Container'Class
         )  return Boolean;

These functions check whether Dependant refers to Referent or, when the second parameter is a container, then whether Dependant refers to any of the objects from that container. The result is false if Dependant, Referent is invalid or Referents is empty.

function Is_In
         (  Container : Deposit_Container'Class;
            Object    : Handle
         )  return Boolean;

This function returns true if Object is in Container. When Object is an invalid handle, the result false.

function Is_Valid (Object : Handle) return Boolean;

This function checks whether a handle points to any object, i.e. is valid.

function Ptr (Object : Handle) return Deposit_Ptr;

This function is used to get a pointer to the object the handle Object points to. The pointer of to the object shall be used no longer the handle it was get from exists. A safe way to do it is to avoid declarations of any variables of the type Deposit_Ptr.

function Ref (Thing : Object_Type_Ptr) return Handle;

This function is used to get a handle from a pointer to an persistent object.

function Ref
         (  Container : Deposit_Container'Class;
            Index     : Positive
         )  return Handle;

This function can be used to enumerate the objects in a container. Objects are enumerated from 1. The result is a valid handle to an object in Container. Contraint_Error is propagated when Index is wrong. Note that objects may repeat in containers of some types.

function References (Object : Handle) return Deposit_Set;

This function is used to query all objects its argument depends on. The result is a set of objects. It is empty if Object is an invalid handle.

procedure Set (Object : in out Handle; Thing : Object_Type_Ptr);

This procedure resets the handle Object to a possibly another object. In the course of this operation the previously pointed object may be destroyed if Object was the last handle pointing to it. It is safe when Thing is the object already pointed by the handle. When Thing is null, this procedure is equivalent to Invalidate.

The package Deposit_Handles provides an instantiation of Object.Archived.Handle:

package Deposit_Handles is
   new
Object.Archived.Handle (Deposit, Deposit_Ptr);

[Back][TOC][Next]

2.3. Persistent directories

There is no need to have dedicated objects to serve as persistent directories as any object could become a directory. Nevertheless the package Persistent.Directory provides objects which can be used as directories. They have no any functionality except an ability to persist. The package declares:

procedure Create
          (  Storage   : in out Storage_Handle;
             Directory : out Deposit_Handle;
             Name      : String;
             Parent    : Deposit_Handle := Root_Directory
          );

This procedure creates a new directory with the name Name and Parent as the parent directory. The result is a handle Directory to the object. The parameter Storage is a handle Storage_Handle to the persistent storage object where the directory has to be created.

Exceptions
Constraint_Error Invalid handle Storage, Parent is not persistent in Storage
Data_Error Inconsistent Storage
Name_Error Illegal name (such as empty), name conflict

function Is_Directory (Object : Deposit_Handle) return Boolean;

This function returns true if Object is a valid handle to a directory object.

Directory_Class : constant String := "Directory";

Is the class name of the directory objects.

[Back][TOC][Next]

2.4. Persistent storage implementation example

This paragraph describes a simplified example of persistent storage. It provides an implementation of a persistent storage based on direct access file. As an example of persistent objects serve nodes of binary trees.

2.4.1. Persistent storage implementation

The implementation uses a direct access file to store objects. Each object is stored in one file record. The record number serves as the object key. Observe that the implementation is independent from any implementation of concrete persistent object types (derived from Deposit). This example serves illustrative purpose. For abstract persistent storage interface see Persistent, Persistent.Handle. For persistent storage implementations see Persistent.Handle.Factory.

File test_persistent_file_storage.ads:
with Ada.Direct_IO;                                                     
with Ada.Finalization;
with Generic_Map;
with Object.Handle;

with Object.Archived;  use Object.Archived;
with Deposit_Handles;  use Deposit_Handles;

package Test_Persistent_File_Storage is
   --
   -- File_Storage -- Direct I/O based storage for persistent objects
   --

   type File_Storage is
      new
Ada.Finalization.Limited_Controlled with private;
   --
   -- Key -- To reference stored objects = record number 1..
   --
   type Key is new Integer;
   subtype Deposit_Handle is Deposit_Handles.Handle;

   procedure Initialize (Storage : in out File_Storage);
   procedure Finalize (Storage : in out File_Storage);
   procedure Clean_Up;
   function Store
            (  Storage : access File_Storage;
               Object : Deposit_Handle
            )  return Key;
   function Restore
            (  Storage : access File_Storage;
               ID      : Key
            )  return Deposit_Handle;

Here we declare the type File_Storage as a limited controlled type. The procedures Initialize / Finalize are overridden to provide construction / destruction. Upon construction the file is opened. Upon destruction it is closed. The procedure Clean_Up is provided to delete the file. The function Store will be used to store an object. It returns the object key, which identifies the object there. The key has the type Key also declared in this package. It is the number of the record reserved for the object in the file. When the object is already persistent in the file, its key is returned, so it is safe to call Store multiple times. The function Restore is the operation opposite to Store. It takes the object key and returns a handle to the object. Restore is also safe to call multiple times. So when the object referenced by a key, is already memory resident, a handle to it is returned instead of creating a new memory resident copy. The type Handle from the package Deposit_Handles is used to reference persistent objects. Deposit_Handles.Handle is "renamed" to Deposit_Handle for convenience. The objects themselves are never referenced directly but through handles only.

File test_persistent_file_storage.ads (continued, the private part):
private                                                                 
   --
   -- Index_Record -- One per bound object
   --
  
type Index_Record (Storage : access File_Storage) is
      new
Backward_Link with
   record

     ID : Key; -- Object identifier
   end record;
   type Index_Record_Ptr is access all Index_Record'Class;
   --
   -- Implementation of Backward_Link's operation
   --
  
procedure Deleted
             (  Link  : in out Index_Record;
                Temps : in out Deposit_Container'Class
             );
   procedure Destroyed (Link : in out Index_Record);

A File_Storage object encapsulates the file and an index of all memory resident objects from that file. The index consists of Index_Records. One record is allocated per memory resident object. Index_Record is derived from Backward_Link to monitor what happens with the object. It also contains the object's key in the file. Two operations of Backward_Link need to be implemented: Deleted and Destroyed. The implementation of Deleted is called upon a request of object deletion. It does nothing in our case. Destroyed is called when the object is about to be finalized. In our case we store that object into the file. A more advanced implementation would check if the object was modified. It could also check if the object was requested for deletion and is no more referenced from other objects, in which case it can be removed from the persistent storage as well. But that would be too complex for a small illustrative example.

File test_persistent_file_storage.ads (continued, the private part):
   --                                                                   
   -- Record_Handles -- Handles to index records
   --
   package Record_Handles is
      new
Object.Handle (Index_Record, Index_Record_Ptr);
   use Record_Handles;
   subtype Record_Handle is Record_Handles.Handle;
   --
   -- Map : object pointer -> record handle
   --
   function "<" (Left, Right : Deposit_Ptr) return Boolean;
   package Object_Maps is
      new
Generic_Map
          (  Key_Type    => Deposit_Ptr,
             Object_Type => Record_Handle
          );
   use Object_Maps;
   subtype Object_Map is Object_Maps.Map;
   --
   -- Map : object key -> record handle
   --
   package Key_Maps is
      new
Generic_Map
          (  Key_Type    => Key,
             Object_Type => Record_Handle
          );
   use Key_Maps;
   subtype Key_Map is Key_Maps.Map;

To reference Index_Record we will use handles provided by Record_Handles, an instantiation of Object.Handle. A handle to Index_Record is "renamed" to Record_Handle. Then we declare two maps: one to map objects to index records, another to map keys to the records. For this the package Generic_Map is instantiated once as Object_Maps and once as Key_Maps. Both use Record_Handle to reference Index_Record. So when the index record is deleted it is enough to remove it from the both maps and the object Index_Record will be automatically collected. Note also that Object_Map uses Deposit_Ptr, a pointer to the persistent object rather than a handle to it. It is important to allow object deletion. Otherwise an object would be never deleted as long as Index_Record referring it exists, i.e. up to File_Storage finalization. It would a thinkable, but too crude implementation. Generic_Map requires map keys be comparable, so the implementation declares "<" on Deposit_Ptr.

File test_persistent_file_storage.ads (continued, the private part):
   --                                                                   
   -- File record
   --
   type Reference_List is array (Integer range 1..256of Key;
   type File_Record is record
      Length     : Natural := 0;
      Count      : Natural := 0;
      References : Reference_List;
      Descriptor : String (1..1024);
   end record;
   package Record_Files is new Ada.Direct_IO (File_Record);
   use Record_Files;
   --
   -- File_Storage -- Implementation
   --
   type File_Storage is
      new
Ada.Finalization.Limited_Controlled with
   record

      File             : File_Type;
      Object_To_Record : Object_Map;
      Key_To_Record    : Key_Map;
      Last_ID          : Key := 0; -- Last used object key
   end record;

end Test_Persistent_File_Storage;

The type File_Record describes one record in the file. The field References is the list of the keys of all the objects referred by the object. Count is the length of the list. The field Descriptor is a string describing the object. The length of the string is the field Length.

File test_persistent_file_storage.adb:
with Object.Archived.Lists;  use Object.Archived.Lists;                 
with Strings_Edit;           use Strings_Edit;

package body Test_Persistent_File_Storage is

   function "<" (Left, Right : Deposit_Ptr) return Boolean is
   begin
      if
Right = null then
         return
False;
      elsif Left = null then
         return
True;
      else
         return
Less (Left.all, Right.all);
      end if;
   end "<";

   procedure Clean_Up is
      File : File_Type;
   begin
      Create (File, Out_File, "test.dat");
      Close (File);
   end Clean_Up;

The implementation of "<" uses Less defined on objects to order them. Clean_Up opens the file in Out_File mode and immediately closes it. This erases the file.

File test_persistent_file_storage.adb (continued):
   procedure Write                                                      
             (  Storage : in out File_Storage;
                Object  : Deposit'Class;
                ID      : Key
             )  is
      References  : Deposit_List;
      Data_Record : File_Record;
      Pointer     : Integer := Data_Record.Descriptor'First;
   begin
      Get_Referents (Object, References);
      Data_Record.Count := Get_Size (References);
      for Item in 1..Data_Record.Count loop
         Data_Record.References (Item) :=
            Store (Storage'Access, Ref (References, Item));
      end loop;
      Put (Data_Record.Descriptor, Pointer, Get_Class (Object));
      Put (Data_Record.Descriptor, Pointer, ":");
      Store (Data_Record.Descriptor, Pointer, Object);
      Data_Record.Length := Pointer;
      Write (Storage.File, Data_Record, Count (ID));
   end Write;

The procedure Write is defined to store an object under the specified key. It calls to Get_Referents to obtain the list of the objects the stored object needs. Then for each such object it calls Store to ensure the object persistency in the file. The keys returned by Store are placed into the References array. After that Write starts to form the field Description. It places the object class there (Get_Class) followed by a colon. Then object's Store is called to query the object description and to add it to Description. The completed object record is then written into the file.

File test_persistent_file_storage.adb (continued):
   procedure Initialize (Storage : in out File_Storage) is              
   begin

      Open (Storage.File, Inout_File, "test.dat");
      Storage.Last_ID := Key (Size (Storage.File));
   end Initialize;

   procedure Finalize (Storage : in out File_Storage) is
   begin
      while not
Is_Empty (Storage.Key_To_Record) loop
         declare

            Index_Item : Index_Record renames
            Ptr (Get (Storage.Key_To_Record, Integer'(1))).all;
         begin
            Write (Storage, This (Index_Item).all, Index_Item.ID);
         end;
         Remove (Storage.Key_To_Record, Integer'(1));
         Remove (Storage.Object_To_Record, 1);
      end loop;
      Close (Storage.File);
   end Finalize;

   procedure Bind
             (  Storage : access File_Storage;
                Object  : Deposit_Handle;
                ID      : Key
             )  is
      Link_Ptr   : Backward_Link_Ptr := new Index_Record (Storage);
      Index_Item : Index_Record renames Index_Record (Link_Ptr.all);
   begin
      Index_Item.ID := ID;
      Attach (Link_Ptr, Ptr (Object));
      Add
      (  Storage.Object_To_Record,
         Ptr (Object),
         Ref (Index_Item'Unchecked_Access)
      );
      Add
      (  Storage.Key_To_Record,
         ID,
         Ref (Index_Item'Unchecked_Access)
      );
   end Bind;

The implementation of Initialize just opens the file for input / output and initializes the field Last_ID. Finalize goes through the index of memory resident objects (the key to object map). For each record of the index it calls Write to store the corresponding object and then removes the references to the index record from both maps. This in turn deletes the record itself. Note how This is used to get the object. The procedure Bind is defined to create an index record. It calls to Attach to bind Index_Record with the object and places handles to Index_Record in each of the maps. Ref is used to obtain them

File test_persistent_file_storage.adb (continued):
   function Store
            (  Storage : access File_Storage;
               Object  : Deposit_Handle
            )  return Key is
      This : Deposit_Ptr := Ptr (Object);
   begin
      if 
This = null or else not Is_In (Storage.Object_To_Record, This)
      then
         Storage.Last_ID := Storage.Last_ID + 1;
         Bind (Storage, Object, Storage.Last_ID);
         return Storage.Last_ID;
      else
         return
Ptr (Get (Storage.Object_To_Record, This)).ID;
      end if;
   end Store;

The implementation of Store first looks into the index to check if it is already there. If yes it returns the key of the object. Otherwise it generates a new key by incrementing the field Last_ID and calls Bind to create a new index record.

File test_persistent_file_storage.adb (continued):
   function Restore (Storage : access File_Storage; ID : Key)
      return Deposit_Handle is
   begin

      if Is_In (Storage.Key_To_Record, ID) then
         return Ref (This (Ptr (Get (Storage.Key_To_Record, ID)).all));
      else
         --
         -- Read the object from the file
         --

         declare
            Data    : File_Record;
            List    : Deposit_List;
            Object  : Deposit_Ptr;
            Result  : Deposit_Handle;
            Pointer : Positive;
         begin
            Read (Storage.File, Data, Count (ID));
            for No in 1..Data.Count loop
               Add (List, Restore (Storage, Data.References (No)));
            end loop;
            Pointer := Data.Descriptor'First;
            while Data.Descriptor (Pointer) /= ':' loop
               Pointer := Pointer + 1;
            end loop;
            Pointer := Pointer + 1;
            Create
            (  Data.Descriptor,
               Pointer,
               Data.Descriptor (Data.Descriptor'First..Pointer - 2),
               List,
               Object
            );
            Result := Ref (Object);
            Bind (Storage, Result, ID);
            return Result;
         end;
      end if;
   end Restore;

The procedure Restore checks the index if an object with the specified key was already created. If yes it returns a handle to the object. This is used to get an object pointer from Index_Record. When the key identifies an unknown object, Restore reads its record from the file. The key is the record number. Restore goes through the array References and for each key calls itself to ensure this object to be restored too. The returned handle to that object is placed in a Deposit_List container. The container together with Descriptor's prefix (up to the first colon) as object's class name and the rest of it as the object's description, are passed to Create. That creates the object. A handle to it is then returned after Bind is called to place the object into the storage index.

File test_persistent_file_storage.adb (continued):
   procedure Deleted                                                    
             (  Link  : in out Index_Record;
                Temps : in out Deposit_Container'Class
             )  is
   begin
      null
;
   end Deleted;

   procedure Destroyed (Link : in out Index_Record) is
   begin

      Write (Link.Storage.all, This (Link).all, Link.ID);
      Remove (Link.Storage.Object_To_Record, This (Link));
      Remove (Link.Storage.Key_To_Record, Link.ID);
   end Destroyed;

end Test_Persistent_File_Storage;

The implementation of Deleted does nothing. Destroyed writes the object into the file and then removes it from the index.

2.4.2. Persistent objects implementation

Let's take binary tree node as an example of persistent object. A node may have up to two successors or none. Predecessor - successor relation is naturally mapped to dependant - referent.

File test_persistent_tree.ads:
with Object.Archived;  use Object.Archived;                             
with Deposit_Handles;  use Deposit_Handles;

package Test_Persistent_Tree is
   --
   -- Nothing -- No node handle
   --

   function Nothing return Handle;
   --
   -- Create_Node -- This function creates a new node
   --
   -- Field - Identifies the node
   -- Left  - Successor on the left (a handle to)
   -- Right - Successor on the right (a handle to)
   --

   function Create_Node
            (  Field : Integer;
               Left  : Handle := Nothing;
               Right : Handle := Nothing
            )  return Handle;
   --
   -- Print -- Prints the tree rooted in a node
   --
   --    Root - The root node (a handle to)
   --
   procedure Print (Root : Handle; Indentation : String := "");

private
   --
   -- Node -- Binary tree node type
   --
   type Node is new Deposit with record
      Field : Integer; -- Node identifier
      Left  : Handle;  -- Left successor, a handle to
      Right : Handle;  -- Right successor, a handle to
   end record;
   --
   -- Implementation of Deposit's operations
   --

   function Get_Class (Object : Node) return String;
   procedure Get_Referents
             (  Object    : Node;
                Container : in out Deposit_Container'Class
             );
   function Is_Modified (Object : Node) return Boolean;
   procedure Reset_Modified (Object : in out Node);
   procedure Restore
             (  Source  : String;
                Pointer : in out Integer;
                Class   : String;
                List    : Deposit_Container'Class;
                Object  : out Deposit_Ptr
             );
   procedure Store
             (  Destination : in out String;
                Pointer     : in out Integer;
                Object      : Node
             );
end Test_Persistent_Tree;

The public part of the package declares the function Create_Node and the procedure Print. Create_Node creates a new node and returns a handle to it. All nodes are referenced using Handle of Deposit_Handles. Each node is identified by an integer number. The next two parameters of Create_Node are the handles to the left and right successors. They are defaulted to an invalid handle for which the function Nothing is also declared. It plays role of a constant invalid handle. The procedure Print is used for control.  It prints the tree rooted in the node specified by the parameter Root.

The private part is straightforward. It declares the type Node as a descendant of Deposit. The operations Get_Class, Get_Referents, Is_Modified, Reset_Modified, Restore and Store are overridden to provide implementations.

File test_persistent_tree.adb:
with Ada.Text_IO;            use Ada.Text_IO;                           
with Strings_Edit;           use Strings_Edit;
with Strings_Edit.Integers;  use Strings_Edit.Integers;

package body Test_Persistent_Tree is
   Class : constant String := "Node"; -- The class of

   function Nothing return Handle is
      None : Handle;
   begin
      return
None;
   end Nothing;

   function Create_Node
            (  Field : Integer;
               Left  : Handle := Nothing;
               Right : Handle := Nothing
            )  return Handle is
      Node_Ptr : Deposit_Ptr := new Node;
      Object   : Node renames Node (Node_Ptr.all);
   begin
      Object.Field := Field;
      Object.Left  := Left;
      Object.Right := Right;
      return Ref (Node_Ptr);
   end Create_Node;

   function Get_Class (Object : Node) return String is
   begin
      return
Class;
   end Get_Class;

   procedure Get_Referents
             (  Object    : Node;
                Container : in out Deposit_Container'Class
             )  is
   begin
      if Is_Valid (Object.Left) then
         Add (Container, Object.Left);
      end if;
      if Is_Valid (Object.Right) then
         Add (Container, Object.Right);
      end if;
   end Get_Referents;

   function Is_Modified (Object : Node) return Boolean is
   begin
      return 
True; -- Save it always, do not care about performance
   end Is_Modified;

   procedure Reset_Modified (Object : in out Node) is
   begin
      null
;
   end Reset_Modified;

The implementation of Get_Referents places handles to the node successors into a Deposit_Container. The left successor is placed first. Is_Modified and Reset_Modified are void for sake of simplicity. So a node is always written into the persistent storage even if it is not changed.

File test_persistent_tree.adb (continued):
   procedure Restore                                                    
             (  Source  : String;
                Pointer : in out Integer;
                Class   : String;
                List    : Deposit_Container'Class;
                Object  : out Deposit_Ptr
             )  is
      Field : Integer;
      Left  : Handle;
      Right : Handle;
   begin
      if
Source (Pointer) = '<' then
         Left := Ref (List, 1);
         if Source (Pointer + 1) = '>' then
            Right := Ref (List, 2);
         end if;
      elsif Source (Pointer + 1) = '>' then
         Right := Ref (List, 1);
      end if;
      Pointer := Pointer + 2;
      Get (Source, Pointer, Field);
      Object := new Node;
      declare
         Item : Node renames Node (Object.all);
      begin
         Item.Field := Field;
         Item.Left  := Left;
         Item.Right := Right;
      end;
   exception
      when others
=>
         raise Data_Error;
   end Restore;

The implementation of Restore first gets description of node dependencies from the source string. It is two characters. The first one is either '<' if there is a left successor or '-' otherwise. The second is '>' if there is a right successor or else '-'. After that it gets the node identifier (plain integer number). Then a new node object is allocated. Note that the target access type should be Deposit_Ptr to ensure right storage pool selection.

File test_persistent_tree.adb (continued):
   procedure Store                                                      
             (  Destination : in out String;
                Pointer     : in out Integer;
                Object      : Node
             )  is
   begin
      if
Is_Valid (Object.Left) then
         Put (Destination, Pointer, "<");
      else
         Put (Destination, Pointer, "-");
      end if;
      if Is_Valid (Object.Right) then
         Put (Destination, Pointer, ">");
      else
         Put (Destination, Pointer, "-");
      end if;
      Put (Destination, Pointer, Object.Field);
   end Store;

   procedure Print (Root : Handle; Indentation : String := "") is
   begin
      if
Is_Valid (Root) then
         declare

            The_Node : Node renames Node (Ptr (Root).all);
         begin
            Put_Line (Indentation & "\_" & Image (The_Node.Field));
            Print (The_Node.Left, Indentation & " |");
            Print (The_Node.Right, Indentation & " ");
         end;
      else
         Put_Line (Indentation & "\_*");
      end if;
   end Print;

begin
   Register_Class (Class, Restore'Access);
end Test_Persistent_Tree;

The procedure Store is reverse to Restore. Also the package defines a new class of persistent objects named Node. For this it calls Register_Class once upon elaboration with the class name and a pointer to Restore as parameters.

2.4.3. Test program

The test program is shown below. It consists of two sessions. In the first session an object is stored. In the second one it is restored.

File test_persistent_storage.adb:
with Ada.Text_IO;                   use Ada.Text_IO;                    
with Test_Persistent_File_Storage;  use Test_Persistent_File_Storage;
with Test_Persistent_Tree;          use Test_Persistent_Tree;
with Deposit_Handles;               use Deposit_Handles;

procedure Test_Persistent_Storage is
   Root_Key : Key;
begin
   Clean_Up;
   Put_Line ("Session 1");
   declare
      DB   : aliased File_Storage;
      Root : Handle;
   begin
      Root :=
         Create_Node
         (  1,
            Create_Node (2),
            Create_Node
            (  3,
               Create_Node
               (  4,
                  Create_Node (5)
               ),
               Create_Node (6)
         )  );
      Print (Root);
      Root_Key := Store (DB'Access, Root);
   end;
   Put_Line ("Session 2");
   declare
      DB   : aliased File_Storage;
      Root : Handle;
   begin
      Root := Restore (DB'Access, Root_Key);
      Print (Root);
   end;
end Test_Persistent_Storage;

The test program first calls Clean_Up to delete any existing storage file. Then it declares DB, a File_Storage object. After that a tree is created and Root becomes a handle to the tree root node. The tree is printed and then its root node is stored into DB. There result of the operation is the external key of the root node. This key can be used to restore the object. Note that the whole tree is stored because the any node depends on its child nodes. What Store does depends on the implementation. In our case physical file writing happens either upon finalization of the storage object (DB) or upon finalization of the persistent object (Root). Both objects are go out of scope at end closing the first session. The second session uses Restore and the external key to bring the root node back from the storage. Again, all the objects it depends on are restored as well. Finally, the restored tree is printed.

2.4.4. Predefined persistent storage test

The test program that uses an ODBC data base as a persistent storage is shown below:

File test_ODBC_persistence.adb:
with Ada.Text_IO;           use Ada.Text_IO;                            
with Deposit_Handles;       use Deposit_Handles; 
with Persistent.Handle;     use Persistent.Handle;
with Test_Persistent_Tree;  use Test_Persistent_Tree;
with Test_ODBC_Session;     use Test_ODBC_Session;

procedure Test_ODBC_Persistence is
   Name : constant String := "The tree";
begin
   Put_Line ("Session 1");
   declare
      DB   : Storage_Handle := Open;
      Root : Handle;
   begin
      Root :=
         Create_Node
         (  1,
            Create_Node (2),
            Create_Node
            (  3,
               Create_Node
               (  4,
                  Create_Node (5)
               ),
               Create_Node (6)
         )  );
      Print (Root);
      Put (DB, Root, Name);
   end;
   Put_Line ("Session 2");
   declare
     DB   : Storage_Handle := Open;
     Root : Handle;
   begin
      Root := Get (DB, Name);
      Print (Root);
   end;
end Test_APQ_Persistence;

Then it declares DB, a Storage_Handle. The handle is initialized using the function Open defined in Test_ODBC_Session.adb. It prompts for connection parameters and then calls Persistent.ODBC.Create. After that a tree is created and Root becomes a handle to the tree root node. The tree is printed and then its root node is stored into DB as "The three". For this it calls Put. Note that the whole tree is stored because the any node depends on its child nodes. The second session uses Get and the name "The three" to bring the root node back from the storage. Again, all the objects it depends on are restored as well. Finally, the restored tree is printed. Carefully observe that the package Test_Persistent_Tree needed no modifications to be able to work with a different type of storage.

This test program modified for APQ and SQLite are in the files test_APQ_persistence.adb and test_APQ_persistence.adb correspondingly.

[Back][TOC][Next]

2.5. Abstract persistent storage

The package Persistent provides an abstract persistent storage communication object. The corresponding persistent storage can be implemented on the basis of a plain file, data base etc. Objects in the storage are identified by their names. Additionally anonymous objects can be created and deleted as required by the named ones. If an object depends on some other objects, then when stored into the storage, the referred objects are stored as well. If they do not already persist there, these objects will be anonymous. Anonymous persistent objects are subject of garbage collection. The way of collection is determined by the implementation.

The objects can be named. The object names are UTF-8 encoded strings. An  implementation can internally provide other encoding when the persistent storage natively supports Unicode different to UTF-8. Named objects are deleted only on explicit request or when they loose names becoming anonymous. Named objects build a hierarchy, where one named object can be a descendant of another. This hierarchy is a forest. The parent objects serve as folders for their children. It is not specified which nature parent objects should have. Objects of any kind can serve as parents. Also the parent-child relation does not impose any additional dependency between the objects. It is a relation solely between the names of.

The procedure Delete can be applied to a handle to the object in order to request its deletion. If the object cannot be deleted immediately it becomes anonymous for later collection. Persistent storage interfaces are itself objects and are a subject of garbage collection as well. When a named parent object becomes anonymous all its descendants do as well.

The package defines the abstract type Storage_Object which describes the interface of a persistent storage communication object. It is derived from Entity, so persistent storage interface objects are subject of garbage collection:

type Storage_Object is abstract new Object.Entity with private;
type
Storage_Object_Ptr is access Storage_Object'Class;
for
Storage_Object_Ptr'Storage_Pool
   use
Object.Entity_Ptr'Storage_Pool;

It is strongly recommended not to directly use derivatives of Storage_Object. For this purpose serve handles to the objects.

The subtype Deposit_Handle is provided for convenience in referring persistent objects. It "renames" the handle type of the package Deposit_Handles:

subtype Deposit_Handle is Deposit_Handles.Handle;

The root-level objects have no parent. When a subprogram requires a parent specification the constant Root_Directory is used:

Root_Directory : constant Deposit_Handle;

The package instantiates Generic_Set to obtain sets of object names.

package Catalogue is
   new
Generic_Set
       (  Object_Type  => Unbounded_String,
          Null_Element => Null_Unbounded_String
       );

The following operations are defined on Storage_Object:

function Get
         (  Storage : access Storage_Object;
            Name    : String;
            Parent  : Deposit_Handle := Root_Directory
         )  return Deposit_Handle is abstract;

This function returns a handle to a persistent object by its name and a handle to the parent object. The root-level objects have no parents, in which case Parent is an invalid handle. An implementation should first check if the the persistent object already has a memory-resident counterpart. Otherwise it should create one from the persistent storage.

Exceptions
Constraint_Error The object specified by Parent is not persistent in Storage
Data_Error Inconsistent Storage
End_Error No such object
Use_Error The class of the object is unknown. This error means that there is no known Ada type yet registered to handle the objects from the persistent storage. Normally Ada types register their classes upon corresponding package elaboration. If the package is not used by the application, its persistent objects cannot be restored.

function Get_Class
         (  Storage : access Storage_Object;
            Name    : String;
            Parent  : Deposit_Handle := Root_Directory
         )  return String is abstract;

This function returns the class of a persistent object by its name and a handle to the parent object.

Exceptions
Constraint_Error The object specified by Parent is not persistent in Storage
Data_Error Inconsistent Storage
End_Error No such object

function Get_Creation_Time
         (  Storage : access Storage_Object;
            Name    : String;
            Parent  : Deposit_Handle := Root_Directory
         )  return Time is abstract;

This function returns the creation time of a persistent object by its name and a handle to the parent object.

Exceptions
Constraint_Error The object specified by Parent is not persistent in Storage
Data_Error Inconsistent Storage
End_Error No such object

function Get_List
         (  Storage     : access Storage_Object;
            Prefix      : String := "";
            Suffix      : String := "";
            Equivalence : Unicode_Mapping_Function := null;
            Parent      : Deposit_Handle := Root_Directory
         )  return Catalogue.Set is abstract;

This function returns a complete list of all named objects persistent in Storage which have parent object specified by the parameter Parent. The list does not include anonymous persistent objects, which have neither parents nor names. Only names starting with Prefix and ending with Suffix are returned. When names are compared two characters are considered same if their corresponding values returned by Equivalence are same. When Equivalence is null, it is assumed an identity mapping. For case insensitive mappings see Strings_Edit.UTF8.Mapping.To_Lowercase. Prefix and Suffix may not overlap when matched. The list is a set of object names.

Exceptions
Constraint_Error The object specified by Parent is not persistent in Storage
Data_Error Inconsistent Storage

function Get_Name
         (  Storage : access Storage_Object;
            Object  : Deposit_Handle
         )  return String is abstract;

This function returns the object's name in Storage. The object is specified by its handle. Note that object names are relative to their parents, so only a pair name - parent does identify the object.

Exceptions
Constraint_Error Invalid handle or Object does not persist in Storage
Data_Error Inconsistent Storage
Name_Error Object is anonymous

function Get_Parent
         (  Storage : access Storage_Object;
            Object  : Deposit_Handle
         )  return Deposit_Handle is abstract;

This function returns the object's parent in Storage. The object is specified by its handle.

Exceptions
Constraint_Error Invalid handle or Object does not persist in Storage
Data_Error Inconsistent Storage
Name_Error Object is anonymous

function Is_Descendant
         (  Storage : access Storage_Object;
            Object  : Deposit_Handle;
            Parent  : Deposit_Handle
         )  return Boolean is abstract;

This function checks if Object is a direct or indirect descendant of Parent. The result is false if Object is invalid, or else specifies an anonymous or non-persisting in Storage object. Otherwise the result is true when Parent is invalid (i.e. identifies root-level objects) and false when Parent does not persist in Storage. Data_Error is propagated on error in Storage.

function Is_In
         (  Storage : access Storage_Object;
            Name    : String;
            Parent  : Deposit_Handle := Root_Directory
         )  return Boolean is abstract;
function
Is_In
         (  Storage : access Storage_Object;
            Object  : Deposit_Handle
         )  return Boolean is abstract;

These functions check whether an object persists in Storage. The object can be identified either by its name and parent or by a handle to it. When Object is not a valid handle the result is false.

Exceptions
Constraint_Error The object specified by Parent is not persistent in Storage
Data_Error Inconsistent Storage

function Is_Named
         (  Storage : access Storage_Object;
            Object  : Deposit_Handle
         )  return Boolean is abstract;

These functions check whether Object persists and named in Storage. When Object is not a valid handle the result is false.

Exceptions
Data_Error Inconsistent Storage

procedure On_Error
          (  Storage : Storage_Object;
             Text    : String;
             Error   : Exception_Occurrence
          );

This procedure is called on exceptions which cannot be handled, e.g. in Finalize. The default implementation does nothing. It can be overridden in order to write a trace log.

procedure Put
          (  Storage : in out Storage_Object;
             Object  : in out Deposit_Handle;
             Name    : String;
             Parent  : Deposit_Handle := Root_Directory
          )  is abstract;
procedure
Put
          (  Storage : in out Storage_Object;
             Object  : in out Deposit_Handle
          )  is abstract;

These procedures are used to store Object in Storage. The parameters Name and Parent specify the object's name and parent in Storage. When omitted the object is stored as anonymous. Anonymous persistent objects are collected when not used, but not before their memory-resident counterpart vanishes. When Object already persists in Storage and Name and Parent are specified, then they are checked to be same. If this check fails, or Name is empty or illegal, or else conflicts with the name of another object Name_Error is propagated. When name is not specified, no check is made. 

Exceptions
Constraint_Error Invalid handle, Parent does not persist in Storage
Data_Error Inconsistent Storage
Name_Error Illegal name (such as empty) or name conflict

procedure Rename
          (  Storage    : in out Storage_Object;
             Old_Name   : String;
             Old_Parent : Deposit_Handle := Root_Directory
             New_Name   : String;
             New_Parent : Deposit_Handle := Root_Directory
          )  is abstract;
procedure
Rename
          (  Storage    : in out Storage_Object;
             Object     : in out Deposit_Handle;
             New_Name   : String;
             New_Parent : Deposit_Handle := Root_Directory
          )  is abstract;

These procedures change the name of the object specified by either its old name and parent (the parameters Old_Name, Old_Parent) or by a handle to it (the parameter Object). When renamed object was anonymous before renaming it becomes a named one. When Object is an invalid handle or does not refer to a persistent object then Constraint_Error is propagated. End_Error is propagated when Old_Name does not refer any persistent object. No object can become a parent of itself, so a check shall be made whether New_Parent specifies the object or any of its descendant. If yes, Name_Error is propagated.

Exceptions
Constraint_Error Object is invalid handle or does not refer to any object in Storage. New_Parent does not persist in Storage.
Data_Error Inconsistent Storage
End_Error Old_Name indicates no object
Name_Error Illegal name (such as empty) or name conflict. The object is an ancestor of its new parent.

procedure Unname
          (  Storage : in out Storage_Object;
             Name    : String;
             Parent  : Deposit_Handle := Root_Directory
          )  is abstract;
procedure
Unname
          (  Storage : in out Storage_Object;
             Object  : in out Deposit_Handle
          )  is abstract;

These procedures make object anonymous. The object can be specified either by its name and parent or by a handle to it. Unnamed objects are automatically deleted when no more in use. Nothing happens if the object is already unnamed. Nothing also happens if Object is an invalid handle, not a handle to a persistent object or does not exist. Note that anonymous objects are not deleted as long as they have memory-resident counterparts. Observe the difference between Unname and Delete (Object.Archived.Delete) called on an object handle. Delete requests object deletion from both memory and persistent storage. Unname does it for persistent storage only. Both may have no immediate effect if the object is still in use. Note that when a parent object becomes anonymous so all its descendants do.

Exceptions
Constraint_Error The object specified by Parent is not persistent in Storage
Data_Error Inconsistent Storage

[Back][TOC][Next]

2.6. Handles to persistent storage

A persistent storage interface is itself an object, which can be referenced by another object. Usually it is a persistent object which memory-resident counterpart of is a proxy to the data in the persistent storage. For example, for a large data structure it might be very inefficient to load it all into the memory. In this case in the memory one would create a small proxy object, which will query the persistent storage for parts of the object's data as necessary. Such proxy object will require a reference to its persistent storage. This also would prevent the persistent storage interface object from premature destruction. This is why it is strongly recommended to use handles to persistent storage interface objects.

The package Persistent.Handle provides the type Storage_Handle, which serves as a handle to an abstract persistent storage interface object. It is guarantied that a persistent storage interface object will not be destroyed as long at least one handle refers to it.

type Storage_Handle is private;

The following operations are defined on Storage_Handle:

function Get
         (  Storage : Storage_Handle;
            Name    : String / Wide_String;
            Parent  : Deposit_Handle := Root_Directory
         )  return Deposit_Handle;

This function searches for the specified object by its name and parent. The name is an UTF-8 encoded string or else a wide string. If the object is already available a handle to it is returned. Otherwise it first is restored from the persistent storage.

Exceptions
Constraint_Error Invalid handle Storage, Parent is not persistent in Storage
Data_Error Inconsistent Storage
End_Error No such object
Use_Error The class of the object is unknown. This error means that there is no known Ada type yet registered to handle the objects from the persistent storage. Normally Ada types register their classes upon corresponding package elaboration. If the package is not used by the application, its persistent objects cannot be restored.

function Get_Class
         (  Storage : access Storage_Handle;
            Name    : String / Wide_String;
            Parent  : Deposit_Handle := Root_Directory
         )  return String;

These functions return the class of a persistent object by its name and parent. The name can be specified either an UTF-8 encoded string or as a wide string.

Exceptions
Constraint_Error Invalid handle Storage, Parent is not persistent in Storage
Data_Error Inconsistent Storage
End_Error No such object

function Get_Creation_Time
         (  Storage : access Storage_Handle;
            Name    : String / Wide_String;
            Parent  : Deposit_Handle := Root_Directory
         )  return Time;

These functions return the creation time of a persistent object by its name and parent. The name can be specified either an UTF-8 encoded string or as a wide string.

Exceptions
Constraint_Error Invalid handle Storage, Parent is not persistent in Storage
Data_Error Inconsistent Storage
End_Error No such object

function Get_List
         (  Storage     : Storage_Handle;
            Prefix      : String := "";
            Suffix      : String := "";
            Equivalence : Unicode_Mapping_Function := null;
            Parent      : Deposit_Handle := Root_Directory
         )  return Catalogue.Set;
function Get_List
         (  Storage     : Storage_Handle;
            Prefix      : Wide_String;
            Suffix      : Wide_String;
            Equivalence : Unicode_Mapping_Function := null;
            Parent      : Deposit_Handle := Root_Directory
         )  return Catalogue.Set;

These functions return a list of all immediate children of Parent persistent in Storage. Only names starting with Prefix and ending with Suffix are eligible. When names are compared two characters are considered same if their corresponding values according to Equivalence are same. When Equivalence is null, it is assumed an identity mapping. For case insensitive mappings see Strings_Edit.UTF8.Mapping.To_Lowercase. Observe that Prefix may not overlap Suffix when matched. So if Prefix="AB" and Suffix="BC", then "ABC" does not fit, but "ABBC" does. The result of the function is a set of object names. Prefix and Suffix are either UTF-8 encoded or wide strings.

Exceptions
Constraint_Error Invalid handle Storage, Parent is not persistent in Storage
Data_Error Inconsistent Storage

function Get_Name
         (  Storage : Storage_Handle;
            Object  : Deposit_Handle
         )  return String;

This function returns the object's name in Storage. The object is specified by its handle. The result is an UTF-8 encoded string. Note that the object names are relative to the object's parent.

Exceptions
Constraint_Error Invalid handle or Object does not persists in Storage
Data_Error Inconsistent Storage
Name_Error Object is anonymous

function Get_Parent
         (  Storage : Storage_Handle;
            Object  : Deposit_Handle
         )  return Deposit_Handle;

This function returns the object's parent in Storage. The object is specified by its handle.

Exceptions
Constraint_Error Invalid handle or Object does not persists in Storage
Data_Error Inconsistent Storage
Name_Error Object is anonymous

procedure Invalidate (Storage : in out Storage_Handle);

This procedure makes handle pointing to nothing. If it was the last reference to the persistent storage interface object, the latter is destroyed.

function Is_Descendant
         (  Storage : Storage_Handle;
            Object  : Deposit_Handle;
            Parent  : Deposit_Handle
         )  return Boolean;

This function checks if Object is a direct or indirect descendant of Parent. The result is false if Object is invalid, or else specifies an anonymous or non-persisting in Storage object. Otherwise the result is true when Parent is invalid (i.e. identifies root-level objects) and false when Parent does not persist in Storage. Data_Error is propagated on error in Storage.

Exceptions
Constraint_Error Invalid handle Storage
Data_Error Inconsistent Storage

function Is_In
         (  Storage : Storage_Handle;
            Name    : String / Wide_String;
            Parent  : Deposit_Handle := Root_Directory
         )  return Boolean;
function
Is_In
         (  Storage : Storage_Handle;
            Object  : Deposit_Handle
         )  return Boolean;

These functions check whether an object persists in Storage. The object can be identified either by its name and parent or by a handle to it. When Object is not a valid handle the result is false. The name can be specified either an UTF-8 encoded string or as a wide string.

Exceptions
Constraint_Error Invalid handle (Storage), Parent does not persists in Storage
Data_Error Inconsistent Storage

function Is_Named
         (  Storage : Storage_Handle;
            Object  : Deposit_Handle
         )  return Boolean;

These functions check whether Object persists and named in Storage. When Object is not a valid handle the result is false.

Exceptions
Constraint_Error Invalid handle (Storage)
Data_Error Inconsistent Storage

function Is_Valid (Storage : Storage_ Handle) return Boolean;

This function checks whether a handle points to a persistent storage interface object.

function Ptr (Storage : Storage_ Handle) return Storage_Object_Ptr;

This function is used to get a pointer to the object the handle Storage points to. The pointer of to the object shall be used no longer the handle it was get from exists.

procedure Put
          (  Storage : in out Storage_Handle;
             Object  : in out Deposit_Handle;
             Name    : String;
             Parent  : Deposit_Handle := Root_Directory
          );
procedure
Put
          (  Storage : in out Storage_Handle;
             Object  : in out Deposit_Handle;
             Name    : Wide_String;
             Parent  : Deposit_Handle := Root_Directory
          );
procedure
Put
          (  Storage : Storage_Handle;
             Object  : in out Deposit_Handle
          );

These procedures are used to store Object in Storage. The parameters Name and Parent specify the object name there. It can be specified either an UTF-8 encoded string or as a wide string. When the name is omitted the object is stored anonymous. Anonymous persistent objects are collected when no more used. It is safe to put an anonymous object into Storage and then reference it in another persistent object. When Object already persists in Storage and Name is specified, then it is checked that it is same. If this check fails, Name is empty, illegal, or conflicts with the name of another object Name_Error is propagated.

Exceptions
Constraint_Error Invalid handle (Storage or Object), Parent is not persistent in Storage
Data_Error Inconsistent Storage
Name_Error Illegal name (such as empty), name conflict, a renaming attempt

function Ref (Storage : Storage_Object_Ptr) return Storage_Handle;

This function obtains a handle to the persistent storage interface object. Having a handle to the object prevents object's premature destruction.

procedure Rename
          (  Storage    : in out Storage_Handle;
             Old_Name   : String;
             Old_Parent : Deposit_Handle := Root_Directory;
             New_Name   : String;
             New_Parent
: Deposit_Handle := Root_Directory
          );
procedure
Rename
          (  Storage    : in out Storage_Handle;
             Object     : in out Deposit_Handle;
             New_Name   : String;
             New_Parent
: Deposit_Handle := Root_Directory;
          );
procedure
Rename
          (  Storage    : in out Storage_Handle;
             Old_Name   : Wide_String;
             Old_Parent : Deposit_Handle := Root_Directory;
             New_Name   : Wide_String;
             New_Parent : Deposit_Handle := Root_Directory
          );
procedure
Rename
          (  Storage    : in out Storage_Handle;
             Object     : in out Deposit_Handle;
             New_Name   : Wide_String;
             New_Parent : Deposit_Handle := Root_Directory
          );

These procedures change the name of the object specified either by its old name and parent (the parameter Old_Name, Old_Parent) or by a handle to it. The names can be specified either an UTF-8 encoded string or as a wide string. When the renamed object was anonymous before renaming it becomes a named one.

Exceptions
Constraint_Error Invalid handle or Object is not persistent in Storage, New_Parent does not persists in Storage
Data_Error Inconsistent Storage
End_Error Old_Name indicates no object
Name_Error Illegal name (such as empty) or name conflict. New_Parent is anonymous or a descendant of the renamed object

procedure Set (Storage : in out Storage_Handle; Object : Storage_Object_Ptr);

This procedure resets the handle Storage to a possibly another object. In the course of this operation the previously pointed object may be destroyed if Storage was the last handle pointing to it. It is safe when Object is the object already pointed by the handle. When Object is null, this procedure is equivalent to Invalidate.

procedure Unname
          (  Storage : in out Storage_Handle;
             Name    : String / Wide_String;
             Parent
 : Deposit_Handle := Root_Directory
          );
procedure
Unname
          (  Storage : in out Storage_Handle;
             Object  : in out Deposit_Handle
          );

These procedures make an object anonymous. The object can be specified either by its name and parent object or by a handle to it. The name is either an UTF-8 encoded string or a wide string. Unnamed objects are automatically deleted when no more in use. Nothing happens if the object is already unnamed. Nothing also happens if Object is an invalid handle, not a handle to a persistent object or does not exist. Note that anonymous objects are not deleted before objects pointed by either Object or Storage destroyed. There is a difference between Unname and Delete called on an object handle. Delete requests object deletion from both memory and persistent storage. Unname does it for persistent storage only. Both may have no immediate effect if the object is still in use. When an object becomes anonymous so do all its descendants.

Exceptions
Constraint_Error Storage is ot a valid handle, Parent does persists in Storage
Data_Error Inconsistent Storage

[Back][TOC][Next]

2.7. Persistent storage factory

The package Persistent.Handle.Factory provides a factory of persistent storage objects.

function Create_APQ
         (  Server_Type    : Database_Type;
            Data_Base_Name : String;
            User_Name      : String;
            Password       : String;
            Host_Name      : String  := "localhost";
            Port_Number    : Natural := 0;
            Erase          : Boolean := False
         )  return Storage_Handle;

This function creates an APQ persistent storage interface object and returns a handle to it. The object is responsible for interacting with a data base via APQ bindings. A connection is established to the server specified by the parameter Host_Name. The parameter Server_Type identifies the data base engine. It can be Engine_PostgreSQL, Engine_MySQL etc, one of the supported by APQ engines. The enumeration type Database_Type is defined in the package APQ delivered with the APQ distribution. User_Name and Password identify the data base user. Data_Base_Name is the name of a data base managed by the server. Port_Number specifies the TCP/IP port listened by the server. When specified as 0, a reasonable default is used. The parameter Erase when true erases the data base contents by dropping all the tables used for storing persistent objects. If the data base contains any additional tables, they remain untouched.

Exceptions
Data_Error Data base error
Use_Error Connection problem. Either of the parameters identifying server, data base or user might be wrong

function Create_ODBC
         (  Server_Name : String;
            User_Name   : String;
            Password    : String;
            Erase       : Boolean := False
         )  return Storage_Handle;
function Create_ODBC
         (  Server_Name : Wide_String;
            User_Name   : Wide_String;
            Password    : Wide_String;
            Erase       : Boolean := False
         )  return Storage_Handle;

This function creates a connection to an ODBC data base, i.e. any data base that has an ODBC driver and returns a valid handle to the persistent storage interface object to communicate the data base. The parameter Server_Name specifies the data server name. It denotes both the data base and the server (driver). The parameters User_Name and Password specify the user and the password to access the data base. All names here are UTF-8 encoded or wide strings.When the parameter Erase is set to true, all used tables are erased upon establishing the connection. One can use it if there is a possibility that the data base contains some corrupted or undesired data. So the data base would initially contain no persistent objects.

Exceptions
Data_Error Data base error
Use_Error Connection problem. Either of the parameters Server_Name, User_Name, Password might be wrong

[Back][TOC][Next]

2.8. Persistent storage implementations

Simple components provide ready-to-use persistent storage implementations. The package Persistent.Handle.Factory supports run-time selection of the most suitable implementation. That might be undesirable, because the implementations rely on third party products such as GNADE and APQ. So Persistent.Handle.Factory needs all of them installed. Alternatively, if it is known that only a particular implementation will be actually used, one can do it directly without the factory. This will remove any dependency on other implementations. This section describes presently available implementations.

2.8.1. ODBC databases

The package Persistent.Native_ODBC provides an implementation of abstract persistent storage based on Open Database Connectivity (ODBC) interface to data bases. ODBC is provided for a great variety of platforms and data bases. The package declares the following subroutines:

function Create
         (  Server_Name : String;
            User_Name   : String;
            Password    : String;
            Erase       : Boolean := False
         )  return Storage_Handle;

This function creates a connection to an ODBC data base, i.e. any data base that has an ODBC driver and returns a valid handle to the persistent storage interface object to communicate the data base. The parameter Server_Name specifies the data server name. It denotes both the data base and the server (driver). The parameters User_Name and Password specify the user and the password to access the data base. All these parameters are UTF-8 encoded strings. When the parameter Erase is set to true, all used tables are erased upon establishing the connection. One can use it if there is a possibility that the data base contains some corrupted or undesired data. So the data base would initially contain no persistent objects.

Exceptions
Data_Error Data base error
Use_Error Connection problem. Either of the parameters Server_Name, User_Name, Password might be wrong

procedure Disable_Tracing
          (  Storage : in out Storage_Handle
          );

This procedure disables tracing of SQL requests. Constraint_Error is propagated when Storage is not a handle to ODBC persistent storage.

procedure Enable_Tracing
          (  Storage : in out Storage_Handle;
             Name    : String
          );

This procedure starts tracing SQL requests using trace file Name. Constraint_Error is propagated when Storage is not a handle to ODBC persistent storage. Data_Error is propagated on any other error.

function Get_Server_Name (Storage : Storage_Handle) return String;

This function returns the server name. Constraint_Error is propagated when Storage is not a handle to ODBC persistent storage.

function Is_ODBC (Storage : Storage_Handle) return Boolean;

This function returns true if Storage is a valid handle to an ODBC persistent storage interface object.

function Serializable (Storage : Storage_Handle) return Boolean;

This function returns true if the ODBC driver communicated through Storage supports serializable transactions. Constraint_Error is propagated when Storage is not a valid handle to an ODBC persistent storage interface object.

function Unicode (Storage : Storage_Handle) return Boolean;

This function returns true if the ODBC driver communicated through Storage natively supports Unicode. Constraint_Error is propagated when Storage is not a valid handle to an ODBC persistent storage interface object.

Implementation notes. The implementation uses a minimal set of SQL features to support a greater number of data bases. Therefore almost everything, from generating unique keys to ON DELETE CASCADE is implemented without the data base engine. The most suitable types are selected according to the results of SQLGetTypeInfo. As the result the performance might be not optimal.

The minimal requirements for an ODBC driver:

32-bit integers SQL_INTEGER. When 64-bit integers (SQL_BIGINT) are supported, they are used for object unique keys. Otherwise, it is (signed) 32-bit ones
Time stamping SQL_TIMESTAMP.
Variable character strings SQL_LONGVARCHAR
PRIMARY KEY Object primary keys are integers.
MAX() In SELECT
DISTINCT In SELECT
NOW() In INSERT as a value for SQL_TIMESTAMP
NULL In INSERT as a value for string

The implementation tries to serialize data base transactions if the ODBC driver support it. In any case the manual-commit mode is used to provide atomic data base changes. The data base structure consists of three tables:

Table objects:

Column Type Description
object_id 64- or 32-bit integer, primary key, unique Object key
catalogue_name UTF-8 string Object name. Unset if object is anonymous
class_name UTF-8 string Object's class
object_data UTF-8 string Object data
parameters_list UTF-8 string The dependency list
created_at Time stamp Object creation time
parent_id 64- or 32-bit integer The key of the object's parent object

Tables backward_links and direct_links:

Column Type Description
dependant 64- or 32-bit integer Object key
referent 64- or 32-bit integer Object key, the object 

2.8.2. GNADE ODBC databases

The package Persistent.ODBC provides an implementation of abstract persistent storage based on Open Database Connectivity (ODBC) interface to data bases. ODBC is provided for a great variety of platforms and data bases. The package declares the following subroutines:

function Create
         (  Server_Name : String;
            User_Name   : String;
            Password    : String;
            Erase       : Boolean := False
         )  return Storage_Handle;

This function creates a connection to an ODBC data base, i.e. any data base that has an ODBC driver and returns a valid handle to the persistent storage interface object to communicate the data base. The parameter Server_Name specifies the data server name. It denotes both the data base and the server (driver). The parameters User_Name and Password specify the user and the password to access the data base. All these parameters are UTF-8 encoded strings. When the parameter Erase is set to true, all used tables are erased upon establishing the connection. One can use it if there is a possibility that the data base contains some corrupted or undesired data. So the data base would initially contain no persistent objects.

Exceptions
Data_Error Data base error
Use_Error Connection problem. Either of the parameters Server_Name, User_Name, Password might be wrong

procedure Disable_Tracing
          (  Storage : in out Storage_Handle
          );

This procedure disables tracing of SQL requests. Constraint_Error is propagated when Storage is not a handle to ODBC persistent storage.

procedure Enable_Tracing
          (  Storage : in out Storage_Handle;
             Name    : String
          );

This procedure starts tracing SQL requests using trace file Name. Constraint_Error is propagated when Storage is not a handle to ODBC persistent storage. Data_Error is propagated on any other error.

function Get_Server_Name (Storage : Storage_Handle) return String;

This function returns the server name. Constraint_Error is propagated when Storage is not a handle to ODBC persistent storage.

function Is_ODBC (Storage : Storage_Handle) return Boolean;

This function returns true if Storage is a valid handle to an ODBC persistent storage interface object.

function Serializable (Storage : Storage_Handle) return Boolean;

This function returns true if the ODBC driver communicated through Storage supports serializable transactions. Constraint_Error is propagated when Storage is not a valid handle to an ODBC persistent storage interface object.

function Unicode (Storage : Storage_Handle) return Boolean;

This function returns true if the ODBC driver communicated through Storage natively supports Unicode. Constraint_Error is propagated when Storage is not a valid handle to an ODBC persistent storage interface object.

Implementation notes. The implementation uses a minimal set of SQL features to support a greater number of data bases. Therefore almost everything, from generating unique keys to ON DELETE CASCADE is implemented without the data base engine. The most suitable types are selected according to the results of SQLGetTypeInfo. As the result the performance might be not optimal.

The minimal requirements for an ODBC driver:

32-bit integers SQL_INTEGER. When 64-bit integers (SQL_BIGINT) are supported, they are used for object unique keys. Otherwise, it is (signed) 32-bit ones
Time stamping SQL_TIMESTAMP.
Variable character strings SQL_LONGVARCHAR. Also when Unicode is supported (SQL_WLONGVARCHAR) it is used to keep object names. When not supported, object names are stored in plain strings.
PRIMARY KEY Object primary keys are integers.
MAX() In SELECT
DISTINCT In SELECT
NOW() In INSERT as a value for SQL_TIMESTAMP
NULL In INSERT as a value for string

The implementation tries to serialize data base transactions if the ODBC driver support it. In any case the manual-commit mode is used to provide atomic data base changes. The data base structure consists of three tables:

Table objects:

Column Type Description
object_id 64- or 32-bit integer, primary key, unique Object key
catalogue_name UTF-8 string Object name. Unset if object is anonymous
class_name UTF-8 string Object's class
object_data UTF-8 string Object data
parameters_list UTF-8 string The dependency list
created_at Time stamp Object creation time
parent_id 64- or 32-bit integer The key of the object's parent object

Tables backward_links and direct_links:

Column Type Description
dependant 64- or 32-bit integer Object key
referent 64- or 32-bit integer Object key, the object 

The software was tested with:

Some words of warning:

Installation notes. The implementation is based on GNADE 1.5.3a (GNat Ada Database Environment). The GNADE project is distributed under modified GNU Public License. To compile the package Persistent.Handle.Factory you will need a GNADE distribution, at least its part related to ODBC bindings. If you do not use Persistent.Handle.Factory, you need not compile it. For ODBC driver installation refer your data base documentation.

2.8.3. APQ-interfaced databases

The package Persistent.APQ provides an implementation of abstract persistent storage based on Ada95 Database Binding to PostgreSQL/MySQL by Warren W. Gay VE3WWG (APQ). APQ supports a number of data bases accessed via a unified interface. The package Persistent.APQ provides the following subroutines:

function Create
         (  Server_Type    : Database_Type;
            Data_Base_Name : String;
            User_Name      : String;
            Password       : String;
            Host_Name      : String  := "localhost";
            Port_Number    : Natural := 0;
            Erase          : Boolean := False
         )  return Storage_Handle;

This function creates an APQ persistent storage interface object and returns a handle to it. The object is responsible for interacting with a data base via APQ bindings. A connection is established to the server specified by the parameter Host_Name. The parameter Server_Type identifies the data base engine. It can be Engine_PostgreSQL, Engine_MySQL etc, one of the supported by APQ engines. The enumeration type Database_Type is defined in the package APQ delivered with the APQ distribution. User_Name and Password identify the data base user. Data_Base_Name is the name of a data base managed by the server. Port_Number specifies the TCP/IP port listened by the server. When specified as 0, a reasonable default is used. The parameter Erase when true erases the data base contents by dropping all the tables used for storing persistent objects. If the data base contains any additional tables, they remain untouched.

Exceptions
Data_Error Data base error
Use_Error Connection problem. Either of the parameters identifying server, data base or user might be wrong

procedure Disable_Tracing
          (  Storage : in out Storage_Handle
          );

This procedure disables tracing of SQL requests. Constraint_Error is propagated when Storage is not a handle to APQ persistent storage.

procedure Enable_Tracing
          (  Storage : in out Storage_Handle;
             Name    : String
          );

This procedure starts tracing SQL requests using trace file Name. Constraint_Error is propagated when Storage is not a handle to APQ persistent storage. Data_Error is propagated on any other error.

function Is_APQ (Storage : Storage_Handle) return Boolean;

This function returns true if Storage is a valid handle to an APQ persistent storage interface object.

Implementation notes. The data base structure consists of three tables:

Table objects:

Column Type Description
object_id 64- or 32-bit integer, primary key, unique, auto-incremented Object key
catalogue_name UTF-8 string Object name. Unset if object is anonymous
class_name UTF-8 string Object's class
object_data UTF-8 string Object data
parameters_list UTF-8 string The dependency list
created_at Time stamp Object creation time
parent_id 64- or 32-bit integer Parent object key

Tables backward_links and direct_links:

Column Type Description
dependant 64- or 32-bit integer Object key
referent 64- or 32-bit integer Object key, the object 

The software was tested with:

It was not tested under Linux because APQ 2.1 was targeted to 3.x versions of MySQL.

Installation notes. The implementation is based on APQ 2.1. It can be found here. The APQ project is distributed under modified GNU Public License 2 and Ada Community Licenses. To compile the package Persistent.Handle.Factory you will need an APQ distribution. If you do not use Persistent.Handle.Factory, you need not to compile it. You might need to modify the sources in order to be able to work with the recent versions of GNAT compiler, PostgreSQL or MySQL.

2.8.4. SQLite3 databases

The package Persistent.SQLite provides an implementation of abstract persistent storage backed by SQLite databases. SQLite is a data base engine that can be integrated into an application. It does not require a server application. The clients access the data base directly. SQLite is quite useful for lightweight persistence since SQLite requires no installation.

Note that SQLite is also accessible through Persistent.ODBC since SQLite has an ODBC interface. This would rather eliminate the core advantages of SQLite. Unlikely to Persistent.ODBC, the implementation provided by Persistent.SQLite is based on the native bindings with the SQLite database engine statically linked.

The package Persistent.SQLite provides the following subroutines:

function Create
         (  File_Name : String;
            Erase     : Boolean := False
         )  return Storage_Handle;

This function creates an SQLite persistent storage interface object and returns a handle to it. The parameter File_Name is the data base file name (UTF-8 encoded). When the file does not exist, it is created new. The parameter Erase when true erases the data base contents by dropping all the tables used for storing persistent objects. If the data base contained any additional tables, they remain untouched.

Exceptions
Data_Error Data base error
Use_Error File open or creation problem

function Get_File_Name (Storage : Storage_Handle) return String;

This function returns the name of the database backing Storage. Constraint_Error is propagated when Storage is not a handle to SQLite persistent storage.

function Is_SQLite (Storage : Storage_Handle) return Boolean;

This function returns true if Storage is a valid handle to an SQLite persistent storage interface object.

Implementation notes. The data base structure consists of three tables:

Table objects:

Column Type Description
object_id 64-bit integer, primary key Object key
catalogue_name UTF-8 string Object name. Unset if object is anonymous
class_name UTF-8 string Object's class
object_data UTF-8 string Object data
parameters_list UTF-8 string The dependency list
created_at UTF-8 string Object creation time YYYY-MM-DD hh::mm:ss.ssss
parent_id 64-bit integer Parent object key

Tables backward_links and direct_links:

Column Type Description
dependant 64-bit integer Object key
referent 64-bit integer Object key, the object 

2.8.5. Single file implementation

The package Persistent.Single_File provides an implementation of abstract persistent storage backed by persistent transactional files. The package Persistent.SQLite provides the following subroutines:

function Create
         (  File_Name : String;
            Erase     : Boolean  := False;
            Hash_Size : Positive := 256;
            Map_Size  : Positive := 100
         )  return Storage_Handle;

This function creates a persistent storage interface object and returns a handle to it. The parameter File_Name is the data base file name. When the file does not exist, it is created new. The parameter Erase when true erases the data base contents by dropping all the tables used for storing persistent objects. Hash_Size is the number of file blocks kept in the memory. Map_Size is the number of virtual block map stored in the memory.
 

Exceptions
Data_Error Data base error
Use_Error File open or creation problem

function Get_File_Name (Storage : Storage_Handle) return String;

This function returns the name of the database backing Storage. Constraint_Error is propagated when Storage is not a handle to single file persistent storage.

function Is_Single_File (Storage : Storage_Handle) return Boolean;

This function returns true if Storage is a valid handle to a single file persistent storage interface object.

[Back][TOC][Next]

2.9. Implementation of a new persistent storage

This chapter describes the internal packages used to ease implementation of a persistent storage backed by a data base.

2.9.1. Databases

Usually persistent storage is implemented on the basis of an external data base engine. In that data base persistent objects are represented by records or other data structures identified by keys. The packages Persistent.Data_Bank, Persistent.Data_Bank.Index and Persistent.Data_Bank.Indexed are provided for interfacing such data bases. The package Persistent.Data_Bank is the parent package providing basic types. The package Persistent.Data_Bank.Index defines a storage index object to be used at run-time by the storage object. The package Persistent.Data_Bank.Indexed provides a specialized abstract storage which implements the abstract storage operation used the interface defined in Persistent.Data_Bank. That is used to derive a concrete implementation of persistent storage object, that will override the remaining abstract operations.

2.9.2. Storages with keys

The package Persistent.Data_Bank defines abstract interface of the storage objects which identify stored objects using a key. It derives the abstract base type Data_Bank_Object from Storage_Object:

type Data_Bank_Object is abstract
   new
Storage_Object with private;

The keys are provided by implementations by deriving from the abstract base type Persistent_Key:

type Persistent_Key is abstract
   new
Ada.Finalization.Controlled with null record;
type Persistent_Key_Ptr is access Persistent_Key'Class;

The arrays of keys are to be implemented by deriving from the abstract base type Persistent_Key_Array:

type Persistent_Key_Array is abstract
   new
Ada.Finalization.Limited_Controlled with null record;

In order to support data base transactions a special access policy is imposed on Storage_Objects. The type Access_Mutex is used to represent transactions:

type Access_Mutex (Storage : access Data_Bank_Object'Class) is
   abstract new
Ada.Finalization.Limited_Controlled with private;

This type is used as the base for storage specific objects that represent atomic actions on storage, such as data base transactions. Two concrete types are derived from it. Read_Mutex is used for viewing storage content without modification. Write_Mutex is used for full access.

type Read_Mutex is new Access_Mutex with private;
type Write_Mutex is new Access_Mutex with private;

An operation that requires access to Storage_Object that might require data base communication should do it as follows:

declare
  
Transaction : Write_Mutex (DB'Access);
begin
 
  -- Do something with DB
  
Commit (Transaction);
end
;

When Commit is not called on Transaction, because of exception propagation for instance, then Roll_Back will be in the course of Transaction finalization.

type Sharing_Type is (Fully, Read_Only, Read_Write);

Operations defined on mutexes:

procedure Commit (Mutex : in out Access_Mutex);

This procedure is basically one call:

Commit (Mutex.Storage.all);

Commit can be called only once. Multiple commits cause Use_Error propagation. Any other exception indicates a data base error.

procedure Finalize (Mutex : in out Access_Mutex);

The destructor calls Roll_Back if no Commit was called before. This ensures data base consistency upon transaction errors.

Operations defined on keys. Normally an implementation of a persistent storage would provide a derived key type. That should override the following abstract operations:

function Image
         (  Storage : Data_Bank_Object'Class;
            Key     : Persistent_Key
         )  return String is abstract;

This function returns a string unambiguously identifying Key in Storage. Constraint_Error is propagated when Key cannot be used for Storage.

function Null_Key return Persistent_Key is abstract;

This function returns a value that serves as an illegal key which can never indicate an object.

function Value
         (  Storage : Data_Bank_Object;
            Key     : String
         )  return Persistent_Key'Class is abstract;

This function converts string to a key. Data_Error is propagated when Key does not identify a valid key for Storage. The implementation should not check for any objects existing under the key.

function "<" (Left, Right : Persistent_Key)
   return Boolean is abstract;
function "=" (Left, Right : Persistent_Key)
   return Boolean is abstract;

Persistent keys are comparable to provide ordered containers.

Operations defined on arrays of keys. The following abstract operations shall be overridden by an implementation:

function Get
         (  Container : Persistent_Key_Array;
            Index     : Integer
         )  return Persistent_Key'Class is abstract;

This function returns a key by its index. Contraint_Error is propagated when index is wrong.

procedure Put
          (  Container : in out Persistent_Key_Array;
             Index     : Integer;
             Key       : Persistent_Key'Class
          )  is abstract;

This procedure places Key at the position in the array Container specified by Index. The array is expanded as necessary. When an implementation chooses a dense representation of the array it is allowed to fill unspecified array elements with Null_Key, which can be returned by Get without raising Constraint_Error.

Operations defined to handle transactions. Data_Bank_Object declares abstract operations on persistent storage supporting transaction framework:

function Get_Access_Mode (Storage : Data_Bank_Object)
   return Sharing_Type is abstract;

This function returns present sharing mode to Storage.

procedure Commit (Storage : in out Data_Bank_Object) is abstract;

This abstract procedure is called at the end of each transaction: an atomic modification of the persistent storage. There should be no difference between Roll_Back and Commit if the transaction was initiated by Seize_Read. Normally, Commit is never called directly, but only through Commit of a mutex object.

Exceptions
Data_Error Data base error
Use_Error No transaction active

procedure Roll_Back (Storage : in out Data_Bank_Object) is abstract;

This procedure is called when a transaction fails, due to an exception. It is always called from an exception handler which re-raises the exception. For this reason it is not recommended to raise any exceptions in Roll_Back. There is no difference between Roll_Back and Commit if the transaction was initiated by Seize_Read. For a transaction initiated by Seize_Write an implementation should discard any changes made.

procedure Seize_Read
          (  Storage : in out Data_Bank_Object
          )  is abstract;

This procedure is called to initiate a read-only transaction with Storage. Only one transaction can be active at a time. The transaction is finished by either a call to Commit or to Roll_Back. For a read-only transaction there should be no sufficient difference between Commit and Roll_Back

Exceptions
Data_Error Data base error
Use_Error A transaction is already active (optional)

procedure Seize_Write
          (  Storage : in out Data_Bank_Object
          )  is abstract;

This procedure is called to initiate a read/write transaction with Storage. Only one transaction can be active at a time. The transaction is finished by either a call to Commit or to Roll_Back.

Exceptions
Data_Error Data base error
Use_Error A transaction is already active (optional)

Operations defined in terms of keys. It is recommended to check active transaction in implementations of abstract operations and to raise Use_Error. Though it is not mandatory. Carefully observe that object key is a class-wide parameter. An implementation would usually check if the key's specific type is one supported by the data base. If it is not then End_Error should be used to indicate an absent object, except when otherwise is explicitly specified.

The following operations should be implemented:

procedure Delete
          (  Storage : in out Data_Bank_Object;
             Key     : Persistent_Key'Class
          )  is abstract;

This procedure deletes an object by its key. An implementation may proceed from the assumption that all dependent objects are already deleted and no object refers to the deleted one. It can be called only within a transaction following a call Seize_Write.

Exceptions
Data_Error Data base error
Use_Error No write transaction active (optional)

function Find
         (  Storage : access Data_Bank_Object;
            Name    : Wide_String;
            Parent  : Persistent_Key'Class
         )  return Persistent_Key'Class is abstract;

This procedure is used to determine the object's key by the object's name and the key of its immediate parent. It is allowed only within a transaction initiated either by Seize_Read or Seize_Write. The result is Null_Key when the object does not exist.

Exceptions
Data_Error Data base error
End_Error No such table (optional)
Use_Error No transaction active (optional)

function Get
         (  Storage : access Data_Bank_Object;
            Key     : Persistent_Key'Class
         )  return Deposit_Handle is abstract;

This procedure restores a persistent object by its key. An implementation shall check if the object for the specified key is already memory-resident. It is allowed to call only within a transaction initiated either by Seize_Read or Seize_Write

Exceptions
Data_Error Data base error
End_Error No such object
Use_Error No transaction active (optional)

procedure Get_Children
          (  Storage  : in out Data_Bank_Object;
             Key      : Persistent_Key'Class;
             Children : in out Persistent_Key_Array'Class;
             Pointer  : in out Integer
          )  is abstract;

Implementation adds the keys of the immediate children of the object specified by Key into the array Children. The first item is placed at Pointer. Then Pointer is advanced. Get_Children is allowed to call only within a transaction initiated either by Seize_Read or Seize_Write. An implementation need not to check that, but if it does then Use_Error should indicate failed check.

Exceptions
Data_Error Data base error
Use_Error No transaction active (optional)

function Get_Class
         (  Storage : in out Data_Bank_Object;
            Key     : Persistent_Key'Class;
         )  return String is abstract;

Implementation returns the object's class. The function is allowed only within a transaction initiated either by Seize_Read or Seize_Write

Exceptions
Data_Error Data base error
End_Error No such object
Use_Error No transaction active (optional)

function Get_Creation_Time
         (  Storage : in out Data_Bank_Object;
            Key     : Persistent_Key'Class;
         )  return Time is abstract;

Implementation returns the object's creation time. The function is allowed only within a transaction initiated either by Seize_Read or Seize_Write

Exceptions
Data_Error Data base error
End_Error No such object
Use_Error No transaction active (optional)

procedure Get_Data
          (  Storage    : in out Data_Bank_Object;
             Key        : Persistent_Key'Class;
             Class      : out Unbounded_String;
             Data       : out Unbounded_String;
             Parameters : out Unbounded_String
          )  is abstract;

Implementation returns the object's description stored in Storage under Key. The description is used to restore the object. The output parameters are the object's class and data as they were generated by Object.Archived.Store and internally used Parameters, which describe the dependency list of the object being restored. The procedure is allowed only within a transaction initiated either by Seize_Read or Seize_Write

Exceptions
Data_Error Data base error
End_Error No such object
Use_Error No transaction active (optional)

function Get_Dependant
         (  Storage : access Data_Bank_Object;
            Key     : Persistent_Key'Class;
            No      : Positive
         )  return Persistent_Key'Class is abstract;

This function is used to enumerate objects having backward links to the object specified by Key. That are ones which have specified the object in the list of backward links (the parameter Backward_Links of Store and Update). All dependants are enumerated starting from 1. The parameter No specifies the number of a dependant to get. An implementation is allowed to use a cache, so the caller should not undertake any actions which may lead to updating the dependency list of the object. The function is allowed only within a transaction initiated either by Seize_Read or Seize_Write

Exceptions
Data_Error Data base error
End_Error No dependant found, end of list, no such object
Use_Error No transaction active (optional)

function Get_Name
         (  Storage : access Data_Bank_Object;
            Key     : Persistent_Key'Class;
            Parent  : access Persistent_Key'Class
         )  return String is abstract;

Implementation returns the object's name stored in Storage under Key. The result is UTF-8 encoded. When the object has a parent, then the implementation sets Parent to the key of. Otherwise it sets Null_Key there. The function is allowed only within a transaction initiated either by either by Seize_Read or Seize_Write

Exceptions
Constraint_Error The type of Parent does not match one of the object's parent
Data_Error Data base error
End_Error No such object
Name_Error Anonymous object
Use_Error No transaction active (optional)

procedure Get_References
          (  Storage    : in out Data_Bank_Object;
             Key        : Persistent_Key'Class;
             References : in out Persistent_Key_Array'Class;
             Pointer    : in out Integer
          )  is abstract;

Implementation adds the keys of the immediate the objects referenced by the object specified by Key into the array References. The first item is placed at Pointer. Then Pointer is advanced. An implementation need not to go after the references of the references. The procedure Get_References is allowed to call only within a transaction initiated either by Seize_Read or Seize_Write. An implementation need not to check that, but if it does then Use_Error should indicate failed check.

Exceptions
Data_Error Data base error
Use_Error No transaction active (optional)

function Has_Dependants
         (  Storage   : access Data_Bank_Object;
            Key       : Persistent_Key'Class;
            All_Links : Boolean
         )  return Boolean is abstract;

An anonymous object that has no dependants can be deleted, but not before its memory-resident counterpart disappears. It counts only direct links to the object when All_Links is false. Otherwise it counts all links, direct and backward. When key does not specify any object, the result is false. This function is allowed only within a transaction initiated either by either by Seize_Read or Seize_Write

Exceptions
Data_Error Data base error
Use_Error No transaction active (optional)

function Is_In
         (  Storage : access Data_Bank_Object;
            Key     : Persistent_Key'Class
         )  return Boolean is abstract;

This function checks whether Key specify an object persistent in Storage. It is allowed only within a transaction initiated either by either by Seize_Read or Seize_Write

Exceptions
Data_Error Data base error
Use_Error No transaction active (optional)

procedure Put
          (  Storage : in out Data_Bank_Object;
             Key     : Persistent_Key'Class;
             Object  : Deposit'Class
          )  is abstract;

This procedure updates a persistent object by its key. Usually it calls Update for this purpose. It is within a transaction initiated by Seize_Write

Exceptions
Data_Error Data base error
End_Error Key does not identify an object
Use_Error No write transaction active (optional)

procedure Rename
          (  Storage : in out Data_Bank_Object;
             Key     : Persistent_Key'Class;
             Name    : Wide_String;
             Parent  : Persistent_Key'Class
          )  is abstract;

This procedure changes the name of the object specified by Key to Name. The object's parent is specified by the parameter Parent. It is specified as Null_Key for a root-level object. When the renamed object was anonymous before renaming it becomes a named one. I.e. it will not deleted when no more in use. An implementation can proceed from the assumption that the caller has already checked for illegal and conflicting names. This procedure is allowed only within a transaction initiated by Seize_Write.

Exceptions
Data_Error Data base error
End_Error Key does not identify an object (optional)
Name_Error Name conflict, there is another object named so (optional)
Use_Error No write transaction active (optional)

function Store
         (  Storage        : access Data_Bank_Object;
            Name           : String;
            Parent         : Persistent_Key'Class;
            Class          : String;
            Data           : String;
            Parameters     : String;
            Direct_Links   : Deposit_Set;
            Backward_Links : Deposit_Set
         )  return Persistent_Key'Class is abstract;
function Store
         (  Storage        : access Data_Bank_Object;
            Class          : String;
            Data           : String;
            Parameters     : String;
            Direct_Links   : Deposit_Set;
            Backward_Links : Deposit_Set
         )  return Persistent_Key'Class is abstract;

These functions are used to write a persistent object. They are called internally. The parameters Name and Parent specify the name of the object in the storage and its parent. The name should be an unique UTF-8 encoded name. When not specified, the object is anonymous. The parameter Data contains a string unambiguously describing the object of the class specified by the parameter Class. It is normally obtained using Object.Archived.Store. Parameters is used to store additional information about links. The parameters Direct_Links and Backward_Links define the set of objects in Storage the object depends on. Objects mentioned in the set Backward_Links are those which can be deleted without deletion of the object itself. The union of Direct_Links and Backward_Links specifies only directly visible dependencies, it is nCocsure. An implementation usually stores Class and Data under the name Name and corrects a persistent dependency table according to Direct_Links and Backward_Links. Note that initially written object is not referenced. Store is allowed only within a transaction by Seize_Write

Exceptions
Data_Error Data base error
End_Error No such object
Use_Error No write transaction active (optional)

procedure Unname
          (  Storage : in out Data_Bank_Object;
             Key     : Persistent_Key'Class
          )  is abstract;

This procedure makes the object specified by Key anonymous. The object object should be automatically deleted when no more in use, but not before it has a memory-resident counterpart. An implementation can proceed from the assumption that the caller already checked for object existence. The procedure is allowed only within a transaction by Seize_Write

Exceptions
Data_Error Data base error
End_Error No such object (optional)
Use_Error No write transaction active (optional)

procedure Update
          (  Storage        : in out Data_Bank_Object;
             Key            : Persistent_Key'Class;
             Class          : String;
             Data           : String;
             Parameters     : String;
             Direct_Links   : Deposit_Set;
             Backward_Links : Deposit_Set
          )  is abstract;

This procedure is used to update a modified persistent object. It is called internally. The parameter Data contains a string unambiguously describing the object of the class specified by the parameter Class. Parameters is used internally to store additional information about links. It is normally obtained using Object.Archived.Store. The parameters Direct_Links and Backward_Links are same as in Store. An implementation would normally update Class and Data in the object's record and correct persistent dependency table. Update is allowed only within a transaction by Seize_Write

Exceptions
Data_Error Data base error
End_Error No such object (optional)
Use_Error No write transaction active (optional)

2.9.3. Storage index

The child generic package Persistent.Data_Bank.Index implements an index of persistent objects:

generic
   type Data_Bank is abstract new Data_Bank_Object with private;
   type Key is new Persistent_Key with private;
package Persistent.Data_Bank.Index is
   type
Catalogue (Storage : access Data_Bank'Class) is
      new
Ada.Finalization.Limited_Controlled with private;
   type Catalogue_Ptr is access all Catalogue;
   ...

Persistent objects having memory-resident counterparts are said to be bound. For each bound object the storage index of the Catalogue type contains a record. When an object is requested from the persistent storage it is first searched in the index. The index also contains information about object's keys and names. Additionally the index registers a notification object to catch bound objects destruction. Upon destruction of a bound object index checks if the object was anonymous and no more referenced in the persistent storage, if so the object is deleted from the storage. If the memory-resident object was modified it is synchronized with the storage.

The package has two generic parameters:

2.9.4. Indexed storage

The child generic package Persistent.Data_Bank.Indexed implements persistent storage interface using the operations defined in Persistent.Data_Bank:

generic
   type Data_Bank is abstract new Data_Bank_Object with private;
   type Key is new Persistent_Key with private;
package Persistent.Data_Bank.Indexed is ...

The generic parameters:

The package provides the abstract type Indexed_Storage_Object which can be used as the base type for a concrete implementation of a data base interface:

type Indexed_Storage_Object is abstract new Data_Bank with private;

The derived type shall implement the following remaining operations:

Tasking. The implementation provided by default is task-safe. The operations on  Indexed_Storage_Object can be called from concurrent tasks. An unsafe implementation is provided in the subdirectory single-task. The implementation choice in GNAT Ada projects is controlled by the variable "Tasking." When compiled manually or with a compiler other than GNAT, the corresponding implementation must be chosen manually.

2.9.5. Proxy objects

Persistent objects that are not fully represented by their memory-resident counterparts require a reference to the storage they persist in. This is necessary at least to prevent persistent storage interface object from being prematurely destroyed. Further the operation Object.Archived.Restore does not contain a parameter referencing the storage. Special objects of the type Self_Reference defined in the child package Persistent.Data_Bank.Reference serve this purpose. An object may put a Self_Reference in its dependency list (see Object.Archived.Get_Referents) by calling the procedure Add from this package. If it does so then in its Restore it will find a Self_Reference again. The fields of that object denote the persistent storage and the object's key there.

type Self_Reference is new Deposit with record
   Storage : Storage_Handle;
   Key     : Persistent_Key_Ptr;
end record;

The following operations are defined on Self_Reference:

procedure Add
          (  List    : in out Deposit_Container'Class;
             Storage : Storage_Handle;
             Key     : Persistent_Key'Class
          );

This procedure adds to List a reference to Storage. Key is the Storage key of the object that requires a reference to Storage. The reference is placed at the list end. Other operations are implementations of the interface defined in Object.Archived.

The following sample code illustrates using Self_Reference objects. A user-defined persistent object is Proxy_Object. It contains a handle to the storage where it persists and implements some of its operations through communication to the storage. For example, it can be a large array of data stored there. When a piece of data is requested Proxy_Object routes the request to the storage and returns the result. Additionally Proxy_Object contains its key in the storage. Proxy_Object should call Add from its Get_Referents to add reference to the storage in its dependency list. Then upon restore it will find a Self_Reference object in the list passed to its Restore:

type Proxy_Object is new Deposit with record
   Storage : Storage_Handle; -- The storage used
   Key     : Storage_Key;    -- The storage key of the object
   ... 
end record;

procedure
Get_Referents
          (  Object : Proxy_Object;
             List   : in out Deposit_Container'Class
          )  is
begin

   Add
   (  List,
      Object.Storage,
      Object.Key
   );
   ... -- adding other dependencies if any
end Get_Referents;

procedure Restore
          (  Source  : String;
             Pointer : in out Integer;
             Class   : String;
             List    : Deposit_Container'Class;
             Object  : out Deposit_Ptr
          )  is
   Object    : Deposit_Ptr := new Proxy_Object;
   Proxy     : Proxy_Object renames Proxy_Object (Result.all);
   Reference : Self_Reference'Class renames
                  Self_Reference'Class (Get (List, 1).all);
begin
   Proxy.Storage := Reference.Storage;
   Proxy.Key     := Storage_Key (Reference.Key.all);
   ... -- restoring the rest of Proxy_Object as necessary
end Restore;

[Back][TOC][Next]

2.10. Visual browsing of a persistent storage

The package Gtk.Persistent_Storage_Browser provides GTK+ widgets for visual browsing of persistent storages. It is a part of the GtkAda contribution software.

[Back][TOC][Next]

2.11. Blocking files

The package Persistent.Blocking_Files provides blocking access file based on the package Direct_IO from the standard library. The file consists of fixed-size blocks which can be mapped onto the memory cache and accessed there. The size of the cache is specified upon file opening. When a file block is read it is stored in the cache. On a next read attempt the block is accessed from the cache if the block is still there. Updates of a block in the cache does not cause physical output until the file is closed or else the cache is flushed.

The package defines the following constants and types:

Byte_Offset_Bits : constant := implementation defined;

The number of bits used for the byte offset within the block.

Block_Byte_Size : constant := 2 ** Byte_Offset_Bits;

The size of a block in bytes.

type Byte_Index is mod 2 ** 64;

The index type used to point to bytes of the file. The first file byte has the index 0.

type Block_Offset is mod Block_Byte_Size;

This is the index type used within the block.

type Block_Count is implementation defined;
subtype Block_Index is Block_Count range 1..Block_Count'Last;

The type Block_Count is to count file blocks. The type Block_Index is used to enumerate blocks of a file. The first block has the index 1.

type Block_Type is array (Block_Offset) of Unsigned_8;
type Block_Type_Ptr is access all Block_Type;
type Block_Type_Ref is access constant Block_Type;

This is the type of the block.

type Access_Mode is (Read_Mode, Read_Write_Mode, Create_Mode);

The modes of access to the file:

type Persistent_Array is
   new
Ada.Finalization.Limited_Controlled with private;

This type is used to access a blocking file.

Note that the implementation of Persistent_Array is not task-safe. If an object of this type is to be used from concurrent tasks its operations must be called mutually exclusively.

 The following operations are defined on the type.

procedure Close (Container : in out Persistent_Array);

This procedure is used to close file previously opened with Open. All updated cached blocks are written back to the file before it is physically closed. I/O exceptions are propagated on errors.

function Compose
         (  Index  : Block_Index;
            Offset : Block_Offset
         )  return Byte_Index;

This function byte index corresponding to the block Index and the offset Offset within the block. See also Get_Index and Get_Offset.

procedure Finalize (Container : in out Persistent_Array);

This procedure is called upon object finalization. The implementation calls Close. When overridden by a derived type, it must be called from the derived type implementation.

procedure Flush (Container : in out Persistent_Array);

This procedure writes all updated blocks from the cache back to the file. I/O exceptions are propagated on errors.

function Get
         (  Container : access Persistent_Array;
            Index     : Byte_Index
         )  return Block_Type_Ptr;

This function returns a pointer to the block corresponding to Index. The index is zero based byte offset it can point anywhere in the block. The block is read into the memory as necessary. When the file already contains the block corresponding to Index in the file the function is equivalent to Update. Otherwise the procedure allocates a new block. The block is marked as updated. It is written back to the file once removed from the memory. Use_Error is propagated when no file is open or else when the file is opened in read-only mode. I/O exceptions are propagated on other errors. See also Load, Update.

function Get_Block_Size
         (  Pool : Persistent_Array
         )  return Block_Count;

This function returns file size in blocks. Use_Error is propagated when no file open.

function Get_Index (Index : Byte_Index) return Block_Index;

This function returns the file block number corresponding to Index. See also Compose.

function Get_First (Index : Byte_Index) return Byte_Index;

This function returns the offset to the first byte of the block corresponding to Index.

function Get_Name (Container : Persistent_Array) return String;

This function returns name of the file when the file is open. Otherwise Use_Error is propagated.

function Get_Offset (Index : Byte_Index) return Block_Offset;

This function returns the offset corresponding to Index when the block is loaded in the memory. See also Compose.

function Get_Size (Container : Persistent_Array) return Byte_Index;

This function returns the file size in bytes. Use_Error is propagated when no file open.

function Is_Open (Container : Persistent_Array) return Boolean;

This function returns true if the file was open with Open.

function Is_Resident
         (  Container : Persistent_Array;
            Index     : Byte_Index
         )  return Boolean;
function
Is_Resident
         (  Container : Persistent_Array;
            Index     : Block_Index
         )  return Boolean;

This function returns true if the block corresponding to Index is memory-resident.

function Is_Writable (Container : Persistent_Array) return Boolean;

This function returns true if the file was open with Open for writing.

function Load
         (  Container : access Persistent_Array;
            Index     : Byte_Index
         )  return Block_Type_Ref;

This function returns a pointer to the block corresponding to Index. The index is zero based byte offset it can point anywhere in the block. The block is read into the memory as necessary. The result is an immutable pointer, so the function can be used for read-only files. If the file does not have a block corresponding to Index, the result is null. Use_Error is propagated when no file is open. I/O exceptions are propagated on other errors. See also Get, Update.

procedure Open
          (  Container : in out Persistent_Array;
             Name      : String;
             Mode      : Access_Mode := Read_Mode;
             Hash_Size : Positive    := 256;
             Form      : String      := ""
          );

This procedure opens a file specified by Name. Hash_Size specifies the number of blocks kept resident in the memory. Mode is the access mode. Form is the OS-specific parameters to use when opening the file. I/O exceptions are propagated on errors.

procedure Open
          (  Container : in out Persistent_Array;
             Hash_Size : Positive := 256;
             Form      : String   := ""
          );

This variant of Open is used to create a temp file.

procedure Read
          (  Container : in out Persistent_Array;
             Index     : Byte_Index
             Block     : out Block_Type
          );

This procedure is used to explicitly read a block corresponding to Index working around the memory cache. The index is zero based byte offset it can point anywhere in the block. The block is read into Block. If the block was memory-resident, it is taken from there and then removed from the cache in order to prevent duplicity. End_Error is propagated if the file does not have a block containing Index. Use_Error is propagated when no file is open. I/O exceptions are propagated on other errors. See also Write.

function Update
         (  Container : access Persistent_Array;
            Index     : Byte_Index
         )  return Block_Type_Ptr;

This function returns a pointer to the block corresponding to Index. The index is zero based byte offset it can point anywhere in the block. The result is a mutable pointer, so the function can be used only for files opened for writing. The block is read into the memory as necessary and marked as updated. It is written back to the file once removed from the memory. If the file does not have a block containing Index, the result is null. Use_Error is propagated when no file is open or when file is open read-only. I/O exceptions are propagated on other errors. See also Get, Load.

procedure Write
          (  Container : in out Persistent_Array;
             Index     : Byte_Index;
             Block     : Block_Type
          );

This procedure is used to explicitly write a block corresponding to Index working around the memory cache. The index is zero based byte offset it can point anywhere in the block. The block is rewritten with the contents of Block. If the block was memory-resident, it is removed from there any changes made are discarded. If the file does not have a block containing Index, it is padded with blocks which contents is set to the one of Block. Use_Error is propagated when no file is open or when file is open read-only. I/O exceptions are propagated on other errors. See also Read.

2.11.1. Text I/O

The package Persistent.Blocking_Files.Text_IO provides output operations for byte index and byte offset.

procedure Get
          (  Source  : in String;
             Pointer : in out Integer;
             Value   : out Byte_Index
          );

This procedure gets byte index from the string Source. The process starts from Source (Pointer). The parameter Base indicates the base of the expected number. The exception Constraint_Error is propagated if block number or byte offset is out of range. Data_Error indicates a syntax error in the number. End_Error is raised when no number was detected. Layout_Error is propagated when Pointer is not in the range Source'First .. Source'Last + 1.

function Image
         (  Value      : Byte_Index;
            Put_Offset : Boolean := True
         )  return String;

This function returns textual representation of Value. When Put_Offset is true both the block number and the hexadecimal offset within the block are output. Otherwise, it is only the block number.

function Image (Value : Block_Offset) return String;

This function returns textual representation byte offset Value in a block.

function Image (Value : Block_Count) return String;

This function returns textual representation block number Value.

procedure Put
          (  Destination : in out String;
             Pointer     : in out Integer;
             Value       : Byte_Index;
             Put_Offset  : Boolean   := True;
             Field       : Natural   := 0;
             Justify     : Alignment := Left;
             Fill        : Character := ' '
          );

This procedure outputs Value starting from Destination (Pointer). Pointer is advanced after the output. Field, Justify and Fill control output. Layout_Error is propagated when there is no room for output or Pointer is invalid. When Put_Offset is true both the block number and the hexadecimal offset within the block are output. Otherwise, it is only the block number.

procedure Put
          (  Destination : in out String;
             Pointer     : in out Integer;
             Value       : Block_Offset;
             Field       : Natural   := 0;
             Justify     : Alignment := Left;
             Fill        : Character := ' '
          );

This procedure outputs Value starting from Destination (Pointer). Pointer is advanced after the output. Field, Justify and Fill control output. Layout_Error is propagated when there is no room for output or Pointer is invalid.

procedure Put
          (  Destination : in out String;
             Pointer     : in out Integer;
             Value       : Block_Count;
             Field       : Natural   := 0;
             Justify     : Alignment := Left;
             Fill        : Character := ' '
          );

This procedure outputs Value starting from Destination (Pointer). Pointer is advanced after the output. Field, Justify and Fill control output. Layout_Error is propagated when there is no room for output or Pointer is invalid.

function Value (Source : String) return Byte_Index;

This function gets byte index from the string Source. The index can be surrounded by spaces and tabs. The whole string Source should be matched. Otherwise the exception Data_Error is propagated. Also Data_Error indicates a syntax error in the block number or byte offset. The exception Constraint_Error is propagated if the number is not in the range First..Last. End_Error is raised when no number was detected.

[Back][TOC][Next]

2.12. Transactional blocking files

The package Persistent.Blocking_Files.Transactional provides Persistent_Transactional_Array, a variant of Persistent_Array, supporting transactions. A transaction is an atomic file update. Database transactions must be atomic, consistent, isolated and durable. Transactions on Persistent_Transactional_Array have similar properties:

The implementation maps virtual file blocks as seen by the application onto physical file blocks. When a virtual block is updated its physical counterpart is not changed on the disk. Instead of that an unused physical block is allocated and the virtual block is remapped to it. This new physical block is kept overwritten until closing the transaction. The old physical block is said disposed. A disposed block is not changed until an end of the transaction. When the transaction is committed the disposed physical block becomes free to use. When the transaction is rolled back the new block is discarded and becomes free and the disposed block takes its place. Since the physical blocks are not changed during the transaction a system crash before committing it rolls the file, as viewed by the application, back.

The virtual to physical block mapping is stored in the file's physical blocks in the form of segments. Each segment fits one physical block. Changes to the mapping are a part of the transaction.

When the whole map does not fit into a single segment it is split into several segments referenced from the segment of the next level. The depth of this segment tree does not necessarily means that the tree should be actually traversed in order to obtain the physical block. If the segment of the lowest level is already in the memory it is used directly to resolve the virtual block number. Only when the segment is not in the memory the segment of the next level is referenced in order to get the physical block containing the missing segment. Thus the tree is fully traversed only when none of the segments along the path is in the memory. The root segment is always in the memory.

The package defines the file type:

type Persistent_Transactional_Array is
   new
Persistent_Array with private;

This type is used to access a blocking file.

Note that the implementation of Persistent_Transactional_Array is not task-safe. If an object of this type is to be used from concurrent tasks its operations must be called mutually exclusively.

 The following operations are defined on the type.

procedure Close (Container : in out Persistent_Transactional_Array);

This procedure is used to close file previously opened with Open. The pending transaction is rolled back. I/O exceptions are propagated on errors.

procedure Commit (Container : in out Persistent_Transactional_Array);

This procedure commits current transaction and opens a new one.

procedure Finalize (Container : in out Persistent_Transactional_Array);

This procedure is called upon object finalization. The implementation calls Close. When overridden by a derived type, it must be called from the derived type implementation.

procedure Flush (Container : in out Persistent_Transactional_Array);

This procedure writes all updated blocks from the cache back to the file. It is equivalent to Commit. I/O exceptions are propagated on errors.

function Get_Allocated_Size
         (  Container : Persistent_Transactional_Array
         )  return Byte_Index;

This function returns the total physical size of the file in bytes. The function Get_Size returns the total virtual size of the file. Use_Error is propagated when no file open. I/O exceptions are propagated on errors.

function Get_Disposed_Blocks
         (  Container : Persistent_Transactional_Array
         )  return Block_Count;

This function returns the number of disposed physical blocks. Disposed blocks cannot be reused during current transaction. They become available when the transaction is committed. When the transaction is rolled back the disposed blocks become used again. Use_Error is propagated when no file open. I/O exceptions are propagated on errors.

function Get_Free_Blocks
         (  Container : Persistent_Transactional_Array
         )  return Block_Count;

This function returns the number of free physical blocks. When there is no free blocks new blocks are acquired by expanding the file. Use_Error is propagated when no file open. I/O exceptions are propagated on errors.

function Get_Map_Depth (Size : Byte_Index) return Natural;

This function returns depth of the virtual to physical mapping. The mapping is organized in segments fitting a file block. When the map does not fit into single segment it is split into several segments all reverenced from the segment of the next level. The depth is the number of levels in this tree including the root segment.

function Get_Map_Size (Size : Byte_Index) return Natural;

This function returns the size of virtual to physical map needed for 1..Size bytes. The result -1 can be used as the Map_Size parameter of Open.

function Get_Physical
         (  Container : Persistent_Transactional_Array;
            Virtual   : Block_Index
         )  return Block_Count;

This function returns the physical block corresponding to Virtual. When the block is not mapped the result is 0. Use_Error is propagated when no file open. I/O exceptions are propagated on errors.

function Get_Sequence_No
         (  Container : Persistent_Transactional_Array
         )  return Unsigned_64;

This function returns current transaction number. Each transaction has an unique sequence number. Use_Error is propagated when no file open.

function Get_Used_Size
         (  Container : Persistent_Transactional_Array
         )  return Byte_Index;

This function returns the total number of used file bytes. It can be less than the total file size returned by Get_Allocated_Size. It is greater than the virtual file size returned by Get_Size. Use_Error is propagated when no file open. I/O exceptions are propagated on errors.

function Is_Updated
         (  Container : Persistent_Transactional_Array;
            Virtual   : Block_Index
         )  return Boolean;

This function returns true if the file block Virtual was updated. All updated blocks are committed or rolled back upon transaction completion. Use_Error is propagated when no file open. I/O exceptions are propagated on errors.

procedure Open
          (  Container : in out Persistent_Transactional_Array;
             Name      : String;
             Mode      : Access_Mode := Read_Mode;
             Hash_Size : Positive    := 256;
           [ Map_Size  : Positive; ]
             Form      : String      := ""
          );

This procedure opens a file specified by Name. Mode is the file access mode. Hash_Size specifies the number of virtual blocks kept resident in the memory. Map_Size specifies how many segments of the virtual-to-physical mapping are kept cached in the memory. The root segment is always cached. It is recommended that the whole mapping were memory-resident, but for very large files this might be impossible. Get_Map_Size can be used to estimate the required space. Form is the OS-specific parameters to use when opening the file. I/O exceptions are propagated on errors.

procedure Open
          (  Container : in out Persistent_Transactional_Array;
             Hash_Size : Positive := 256;
           [ Map_Size  : Positive; ]
             Form      : String   := ""
          );

This variant of Open is used to create a temp file.

procedure Rollback (Container : in out Persistent_Transactional_Array);

This procedure rolls back current transaction. I/O exceptions are propagated on errors.

2.12.1. Textual output of internal structures

The package Persistent.Blocking_Files.Transactional.Dump provides procedures to output internal structures of a transactional file. The flags controls the output:

type Dump_Flags is mod 2**5;
Dump_General_Information  : constant Dump_Flags := 2**0;
Dump_Virtual_Block_Map    : constant Dump_Flags := 2**1;
Dump_Block_Map_Segments   : constant Dump_Flags := 2**2;
Dump_Free_Blocks_List     : constant Dump_Flags := 2**3;
Dump_Disposed_Blocks_List : constant Dump_Flags := 2**4;
Dump_All                  : constant Dump_Flags := Dump_Flags'Last;

The procedures defined in the package are:

procedure Put
          (  File      : File_Type;
             Container : Persistent_Transactional_Array'Class;
             Flags     : Dump_Flags := Dump_All
          );
procedure Put
          (  Container : Persistent_Transactional_Array'Class;
             Flags     : Dump_Flags := Dump_All
          );

The parameter File is the file to output into. If omitted the standard output is used. Container is the object to output. Flags controls the output.

[Back][TOC][Next]

2.13. Persistent streams

The package Persistent.Streams provides Persistent_Stream, a stream backed by Persistent_Transactional_Array. The stream can be written and read as a FIFO. The read content can be disposed freeing place in the file. When read beyond the last written element End_Error is propagated.

The package defines the file types:

type Persistent_Stream is
   new
Ada.Streams.Root_Stream_Type with private;

This is the type of the stream.

type Stream_Position is new Byte_Index;

Values of this type indicate a position in the stream. The position is monotonically ascending.

 The following operations are defined on the type.

procedure Close (Stream : in out Persistent_Stream);

This procedure is used to close file previously opened with Open. The pending changes are written into the file. I/O exceptions are propagated on errors. If the stream remains unclosed the updates from the last call to Flush are dropped.

procedure Dispose (Stream : in out Persistent_Stream);
procedure Dispose
          (  Stream : in out Persistent_Stream;
             Upto   : Stream_Position
          );

This procedure removes all previously read content from the stream. The freed space becomes available current transaction and opens a new one. When the parameter Upto is specified it is the first position to keep in the stream. Everything prior to it is disposed.

function End_Of (Stream : Persistent_Stream) return Boolean;

This function returns true if the end of the stream is reached. Reading beyond the end propagates End_Error.

procedure Erase (Stream : in out Persistent_Stream);

This procedure removes all  stream content.

procedure Flush (Stream : in out Persistent_Stream);

This procedure writes all updates to the file. I/O exceptions are propagated on errors.

function Get_Block_Size
         (  Stream : Persistent_Stream
         )  return Block_Count;

This function returns the number of allocated logical blocks. It includes the unused blocks but not the blocks reserved for maintaining redundancy. See also Get_Blocks.

procedure Get_Blocks
          (  Stream          : Persistent_Stream;
             Total_Blocks    : out Block_Count;
             Disposed_Blocks : out Block_Count;
             Free_Blocks     : out Block_Count;
             Logical_Blocks  : out Block_Count;
             Writable_Blocks : out Block_Count
          );

This procedure returns file usage statistics:

Use_Error is propagated when no file open. I/O exceptions are propagated on errors.

function Get_Name
         (  Stream : Persistent_Stream
         )  return String;

This function returns the name of the file backing the stream. Use_Error is propagated when no file open.

function Get_First_Index (Stream : Persistent_Stream)
   return Byte_Index;

This function returns logical index of the first element in the stream. Use_Error is propagated when no file open.

function Get_First_Position (Stream : Persistent_Stream)
   return Stream_Position;

This function returns the position of the first element in the stream. The stream position is monotonically ascending zero-based number. Use_Error is propagated when no file open.

function Get_Read_Index (Stream : Persistent_Stream)
   return Byte_Index;

This function returns logical index of the stream element next to read.. Use_Error is propagated when no file open.

function Get_Read_Position (Stream : Persistent_Stream)
   return Stream_Position;

This function returns the position of the stream element next to read. The stream position is monotonically ascending zero-based number. Use_Error is propagated when no file open.

function Get_Size (Stream : Persistent_Stream) return Stream_Position;

This function returns number of elements in the stream. It is the difference between the write and first positions. Use_Error is propagated when no file open.

function Get_Write_Index (Stream : Persistent_Stream)
   return Byte_Index;

This function returns logical index of the first stream element to write.. Use_Error is propagated when no file open.

function Get_Write_Position (Stream : Persistent_Stream)
   return Stream_Position;

This function returns the position of the first stream element to write. The stream position is monotonically ascending zero-based number. Use_Error is propagated when no file open.

function Is_Empty (Stream : Persistent_Stream) return Boolean;

This function returns true if the stream is empty.

function Is_Open (Stream : Persistent_Stream) return Boolean;

This function returns true if the file backing the stream is open.

procedure Open
          (  Stream    : in out Persistent_Stream;
             Name      : String;
             Mode      : Access_Mode := Read_Mode;
             Hash_Size : Positive    := 256;
             Form      : String      := ""
          );

This procedure opens a file specified by Name. Mode is the file access mode. When Mode is Read_Mode the stream can only be read from and the file must exist. Hash_Size specifies the number of virtual blocks kept resident in the memory. Map_Size specifies how many segments of the virtual-to-physical mapping are kept cached in the memory. I/O exceptions are propagated on errors.

procedure Rewind (Stream : in out Persistent_Stream);

This procedure sets the read position back to the first element. Use_Error is propagated when no file open.

2.13.1. Textual output of internal structures

The package Persistent.Streams.Dump provides procedures to output internal structures of a stream. The flags controls the output:

type Dump_Flags is mod 2**4;
Dump_General_Information  : constant Dump_Flags := 2**0;
Dump_Free_Block_List      : constant Dump_Flags := 2**1;
Dump_Used_Block_List      : constant Dump_Flags := 2**2;
Dump_Block_Contents       : constant Dump_Flags := 2**3;
Dump_All                  : constant Dump_Flags := Dump_Flags'Last;

The procedures defined in the package are:

procedure Put
          (  File   : File_Type;
             Stream : Persistent_Stream'Class;
             Flags  : Dump_Flags := Dump_All
          );
procedure Put
          (  Stream : Persistent_Stream'Class;
             Flags  : Dump_Flags := Dump_All
          );

The parameter File is the file to output into. If omitted the standard output is used. Stream is the object to output. Flags controls the output.


[Back][TOC][Next]

3. Sets and Maps

The packages Generic_Set and Generic_Map provide sets and associative arrays of private types. Objects in a set are directly comparable which makes them distinguishable and so allows to decide whether an object is in a set or not. Objects in a map are indistinguishable and so an additional object called key is associated with each object in the map. In other words a map represents a mapping key to object. Both sets and maps are implemented using reference counting which allows a relatively efficient assigning of sets and maps.

Note that only objects of non-limited type can be used in sets and maps. To have sets of limited objects use pointers or handles as elements. For sets of handles also see Object.Handle.Generic_Set. For maps of strings see Tables.

[Back][TOC][Next]

3.1. Sets

The package Generic_Set defines the type Set. An instance of the type is a set of items. One can add to and remove from items of the set. Items of the set can be accessed using the positive index. They are ordered, so the set implementation may use binary search. There is a null item, which is never included into the set and is used to mark free memory slots. The package is generic and has the following generic parameters:

generic
   type Object_Type is private;
   Null_Element : Object_Type;
   Minimal_Size : Positive := 64;
   Increment    : Natural  := 50;
   with function "<" (Left, Right : Object_Type) return Boolean is <>;
   with function "=" (Left, Right : Object_Type) return Boolean is <>;
package Generic_Set is
   type
Set is new Ada.Finalization.Controlled with private;
   ...

Here:

Sets can be assigned. Assignment makes no deep copy, which is delayed until the time moment when the original and a copy become different. Items in the set are ordered so that lesser items have lesser indices, when indexed. The first item in the set has index 1.

Note that Generic_Set cannot be instantiated with Object_Type set to Integer or any its subtype. This feature is per design for safety reasons. The elements in the set are enumerated by Integer, so if sets of Integer are required then the Object_Type must be made different from Integer. For example as.
type Integer_Object is new Integer;
package Integer_Sets is
   new
Generic_Set (Object_Type => Integer_Object, ...);

The following operations are defined on Set:

procedure Add (Container : in out Set; Item  : Object_Type);
procedure
Add (Container : in out Set; Items : Set);

These procedures are used to add an item to a set or all items of one set to another. Nothing happens if the item is already in the set or is a Null_Element. Note that items are compared using the provided operations "<" and "=". It is possible that these operations treat different items as same. Only one item from such equivalence class may be in a set. To control which one will be inserted use Insert and Replace.

function Create return Set;

This function returns an empty set.

procedure Erase (Container : in out Set);

This procedure removes all items from the set.

function Find (Container : Set; Item : Object_Type)
   return Integer;

This function is used to find an item in the set Container. The result is either a positive index of the found item or a negated index of the place where the item should be if it were in the set.

function Get (Container : Set; Index : Positive)
   return Object_Type;
This function is used to get an item of the set Container using a positive index. Constraint_Error is propagated if Index is wrong.

function Get_Size (Container : Set) return Natural;

This function returns the number of items in the set.

procedure Insert (Container : in out Set; Item : in out Object_Type);

This procedure inserts an item into a set. Nothing happens if the item is Null_Element. When Container already has an element equivalent to Item, then Item will not replace it. Instead of that the element from Container will be returned through Item. So upon completion Item always has the value of the element in Container.

procedure Insert (Container : in out Set; Item : Object_Type; Inserted : out Boolean);

This procedure inserts an item into a set. Item is inserted only if it is not Null_Element and is not already in Container. When inserted Inserted is set to true. Otherwise it is to false..

function Is_Empty (Container : Set) return Boolean;

True is returned if Container is empty.

function Is_In (Container : Set; Item : Object_Type)
   return Boolean;

True is returned if Item is in Container.

procedure Remove (Container : in out Set; Item  : Object_Type);
procedure Remove (Container : in out Set; Items : Set);

These procedures are used to remove items from the set Container. An item can be removed either explicitly, or by specifying a set of items to be removed. If a particular item is not in the set, then nothing happens.

procedure Remove
          (  Container : in out Set;
             Item      : Object_Type;
             Removed   : out Boolean);

This procedure is a variant of the procedure Remove with the third parameter set to true when Item was in the set before its removal. Otherwise it is set to false.

procedure Remove (Container : in out Set; Index : Positive);

This procedures removes an item from the set Container by its positive index. Constraint_Error is propagated when item index is wrong.

procedure Replace (Container : in out Set; Item : Object_Type);
procedure
Replace (Container : in out Set; Items : Set);
These procedures are used to add to / replace in an item or all items of a set. Nothing is done when Item is Null_Element. Any duplicated items are replaced by new ones. This operation has sense only if the equality operation defined on Object_Type does not distinguish some objects.
type Exchange_Condition is
   access function
(New_Element, Old_Element : Object_Type)
      return
Boolean;
procedure
Replace
          (  Container : in out Set;
             Item      : Object_Type;
             Condition : Exchange_Condition;
             Updated   : out Boolean
          );
This procedure replaces element if the function Condition returns true. For a new element to insert the second parameter passed is Null_Element. The parameter Updated is returned true if the set was modified, e.g. element inserted or replaced.

function "and" (Left, Right : Set) return Set;
function "or"  (Left, Right : Set) return Set;
function "xor" (Left, Right : Set) return Set;

These functions are conventional set operations - intersection, union, difference. Difference is defined as a set which items are only in one of the sets Left and Right.

function "-" (Left, Right : Set) return Set;

This function returns a set containing all elements of Left not present in Right.

function "=" (Left, Right : Set) return Boolean;

True is returned if both sets contain same items.

3.1.1. Sets of indefinite elements

The package Generic_Indefinite_Set is similar to the package Generic_Set, but allows instantiation with an indefinite type:

generic
   type Object_Type (<>) is private;
   Minimal_Size : Positive := 64;
   Increment    : Natural  := 50;
   with function "<" (Left, Right : Object_Type) return Boolean is <>;
   with function "=" (Left, Right : Object_Type) return Boolean is <>;
package Generic_Set is
   type
Set is new Ada.Finalization.Controlled with private;
   ...

Note that there is no formal parameter Null_Element. The Replace procedure is different:

type Exchange_Condition is
   access function
(New_Element, Old_Element : Object_Type)
      return Boolean;
type Insert_Condition is
   access function
(New_Element : Object_Type) return Boolean;
procedure Replace
          (  Container : in out Set;
             Item      : Object_Type;
             Exchange  : Exchange_Condition;
             Insert    : Insert_Condition;
             Updated   : out Boolean
          );
This procedure replaces element is the function Exchange returns true. A new element is inserted if Insert returns true. The parameter Updated is returned true if the set was modified, e.g. element inserted or replaced.

3.1.2 Sets of discrete elements

The package Generic_Discrete_Set is similar to the package Generic_Set provided specifically for discrete types allowing large sets of elements as well as their complement sets:

generic
   type Object_Type is (<>);
   Minimal_Size : Positive := 64;
   Increment    : Natural  := 50;
package Generic_Discrete_Set is
   type
Set is new Ada.Finalization.Controlled with private;
   ...

The set supports adding and removing whole ranges of elements. The set cardinality is not limited, but the number of non-intersecting ranges must be no greater than Integer'Last. differently to the package Generic_Set the elements of the set are enumerated through the ranges 1..Get_Size. The following operations are defined on Set:

procedure Add (Container : in out Set; Item     : Object_Type);
procedure
Add (Container : in out Set; From, To : Object_Type);
procedure
Add (Container : in out Set; Items    : Set);

These procedures are used to add an item, a range of items, all items of one set to another. Nothing happens if an item is already in the set or when From..To is an empty range. Constraint_Error is propagated when From > To such that Object_Type'Pred (From) /= To.

function Create return Set;

This function returns an empty set.

function Create (Item     : Object_Type) return Set;
function Create (From, To : Object_Type) return Set;

These functions return a singleton set containing Item or a set consisting of the range From..To. Constraint_Error is propagated when From > To such that Object_Type'Pred (From) /= To.

procedure Erase (Container : in out Set);

This procedure removes all items from the set.

function Find (Container : Set; Item     : Object_Type) return Integer;
function Find (Container : Set; From, To : Object_Type) return Integer;

This function is used to find an item or a range of items in the set Container. The result is either a positive index of an range containing Item or whole range From..To or a negated index of the place where the item should be if it were in the set. Ranges in the set are ordered according to their lower bounds. Intersecting ranges are considered equal. Constraint_Error is propagated when From > To.

function From (Container : Set; Index : Positive) return Object_Type;
This function returns the lower bound of a range from the set Container using its positive index. Constraint_Error is propagated if Index is wrong.
procedure Get
          (  Container : Set;
             Index     : Positive;
             From      : out Object_Type;
             To        : out Object_Type
          );
This function is used to get a range from the set Container using a positive index. The ranges of elements are enumerated by integers from 1..Get_Size. Constraint_Error is propagated if Index is wrong.

function Get_Size (Container : Set) return Natural;

This function returns the number of ranges in the set. Elements of a set can be enumerated by enumerating elements from the ranges 1..Get_Size (Container)

function Is_Empty (Container : Set) return Boolean;

This function returns true if Container is empty.

function Is_In (Container : Set; Item     : Object_Type) return Boolean;
function
Is_In (Container : Set; From, To : Object_Type) return Boolean;

This function returns true if Item or whole From..To is in Container.

function Is_Not_In (Container : Set; From, To : Object_Type) return Boolean;

This function returns true if none of the items from From..To is in Container. Both Is_In and Is_Not_In are false when some elements from From..To belong to the set and some do not.

procedure Range_Remove (Container : in out Set; Index : Positive);

This procedure removes a range of elements by its index. Constraint_Error is propagated when Index does not specify any range. The number of elements ranges is obtaining using the function Get_Size.

procedure Remove (Container : in out Set; Item     : Object_Type);
procedure
Remove (Container : in out Set; From, To : Object_Type);
procedure Remove (Container : in out Set; Items    : Set);

These procedures are used to remove items from the set Container. An item can be removed either explicitly, or by specifying a set of items to be removed. If a particular item is not in the set, then nothing happens. When From..To is an illegal or empty range, the operation does nothing.

function To (Container : Set; Index : Positive) return Object_Type;

This function returns the upper bound of a range from the set Container using its positive index. Constraint_Error is propagated if Index is wrong.

function "and" (Left, Right : Set) return Set;
function "or"  (Left, Right : Set) return Set;
function "xor" (Left, Right : Set) return Set;

These functions are conventional set operations - intersection, union, difference. Difference is defined as a set which items are only in one of the sets Left and Right.

function "-" (Left, Right : Set) return Set;

This function returns a set containing all elements of Left not present in Right.

function "=" (Left, Right : Set) return Boolean;

This function returns true is if both sets contain same items.

[Back][TOC][Next]

3.2. Maps

The package Generic_Map defines the type Map which represents an associative array. One can add to and remove from items of the map. Each item has an unique key associated with it. In other word a map is a function which for a given key yields an item. Items of the map can be also accessed using the positive index. Items in the map are ordered according to their keys, so the map implementation may use binary search. Reference counting is used for the objects of the type Map, which means that assigning Map objects is relatively cheap. The package is generic and has the following generic parameters:

generic
   type Key_Type is private;
   type Object_Type is private;
   Minimal_Size : Positive := 64;
   Increment    : Natural  := 50;
   with function "<" (Left, Right : Key_Type) return Boolean is <>;
   with function "=" (Left, Right : Key_Type) return Boolean is <>;
package Generic_Map is
   type
Map is new Ada.Finalization.Controlled with private;
   ...

Here:

Both Key_Type and Object_Type can be controlled. The implementation warranties that when an item or key is no more used in the map it is erased by assigning it a value created by the default constructor (if any). This behavior ensures that items and keys removed from the map will be always finalized upon the operation. For example, when Object_Type is controlled, then Finalize will be called upon an item of Object_Type even if the item is not replaced but removed from a map. This happens through assigning some other object of Object_Type to the removed item. So when item is a Handle, then the reference count of an object it refers will be decreased as expected. On assignment no deep copy of a map is made. Deep copy is postponed till the time moment when the original and a copy become different. Items in the map are ordered according to their keys, so that items with lesser keys have lesser indices, when indexed. The first item in the map has index 1.

Note that Generic_Map cannot be instantiated with Integer or any its subtype as Key_Type. This feature is per design for safety reasons. The objects in the map are enumerated by Integer, so if maps indexed by Integer are required then Generic_Discrete_Map should be used instead or else the Key_Type must be made different from Integer. For example as:
type Integer_Key is new Integer;
package Integer_Maps is
   new
Generic_Map (Key_Type => Integer_Key, ...);

The following operations are defined on the type Map:

procedure Add
          (  Container : in out Map;
             Key       : Key_Type;
             Item      : Object_Type
          );

This procedure adds a new item (Item) to the map Container. Constraint_Error propagates if Container already contains an item with the key equal to Key.

procedure Add (Container : in out Map; Items : Map);

This procedure adds all items of Items to Container. If Container already has an item with the key equal to an item from Items, then that item from Items is ignored.

function Create return Map;

This function returns an empty map.

procedure Erase (Container : in out Map);

This procedure removes all items from Container.

function Find (Container : Map; Key : Key_Type) return Integer;

This function is used to find an item in the map Container. The result is either a positive index of the found item or a negated index of the place where the item should be if it were in the map.

function Get (Container : Map; Key : Key_Type) return Object_Type;

This returns an item of the map Container by its key. Constraint_Error is propagated if there is no item with the key equal to Key.

function Get (Container : Map; Index : Positive) return Object_Type;

This function is used to get an item of the map Container using positive index. Constraint_Error is propagated if Index is wrong. Note that item index may change when items are added or removed.

function Get_Key (Container : Map; Index : Positive) return Key_Type;
This functions returns the key of an item in Container. Constraint_Error is propagated if Index is wrong.

function Get_Size (Container : Map) return Natural;

This function returns the number of items in the map.

function Is_Empty (Container : Map) return Boolean;

True is returned if Container is empty.

function Is_In (Container : Map; Key : Key_Type)
   return Boolean;

True is returned if Container has an item for Key.

procedure Remove (Container : in out Map; Item  : Key_Type);
procedure Remove (Container : in out Map; Items : Set);

These procedures are used to remove items from the map Container. An item can be removed either by its key, or by specifying a map of items to be removed. If a particular item is not in the map, then nothing happens.

procedure Remove (Container : in out Map; Index : Positive);

This procedures removes an items from the map Container by its positive index. Constraint_Error is propagated when item index is wrong.

procedure Replace
          (  Container : in out Map;
             Key       : Key_Type;
             Item      : Object_Type
          );
procedure
Replace
          (  Container : in out Map;
             Items     : Map
          );
These procedures are used to add or replace items. An can be either added or replaced by its key. That is when Container does contain an item with the key equal to Key, then it is replaced by Item, otherwise Item is added under Key. The second  variant adds or replaces all items from the map Items.
procedure Replace
          (  Container : in out Map;
             Index     : Positive;
             Item      : Object_Type
          );
This procedure replaces an items by its positive index. Contraint_Error is propagated when Index is wrong.

function "=" (Left, Right : Map) return Boolean;

This function returns true is if both parameters map same keys to same items.

3.2.1. Maps of indefinite keys and objects

The package Generic_Indefinite_Map is exactly as the package Generic_Map, but also allows keys and objects of indefinite types:

generic
   type Key_Type (<>) is private;
   type Object_Type (<>) is private;
   Minimal_Size : Positive := 64;
   Increment    : Natural  := 50;
   with function "<" (Left, Right : Key_Type) return Boolean is <>;
   with function "=" (Left, Right : Key_Type) return Boolean is <>;
package Generic_Map is
   type
Map is new Ada.Finalization.Controlled with private;
   ...

3.2.2. Maps of discrete keys

The package Generic_Discrete_Map is designed to provide maps of discrete keys. The implementation takes advantage of using ranges of keys allowing very large maps. Differently to Generic_Map it maps ranges of keys to object. The ranges are split and merged transparently when individual (key, object) pairs added. The package is generic and has the following generic parameters:

generic
   type Key_Type is (<>);
   type Object_Type is private;
   Minimal_Size : Positive := 64;
   Increment    : Natural  := 50;
package Generic_Discrete_Map is
   type
Map is new Ada.Finalization.Controlled with private;
   ...

Here:

The following operations are defined on the type Map:

procedure Add
          (  Container : in out Map;
             Key       : Key_Type;
             Item      : Object_Type
          );
procedure Add
          (  Container : in out Map;
             From, To  : Key_Type;
             Item      : Object_Type
          );

This procedure adds to Container a key or a range of keys mapped to the Item. Constraint_Error propagates if Container already maps another item to any of the required keys. It is also propagated when From > To such that Key_Type'Pred (From) /= To.

procedure Add (Container : in out Map; Items : Map);

This procedure adds all items of Items to Container. If Container already has an item with the key equal to an item from Items, then that item from Items is ignored.

function Create return Map;

This function returns an empty map.

function Create (Keym     : Key_Type; Item : Object_Type) return Map;
function Create (From, To : Key_Type; Item : Object_Type) return Map;

These functions return a mapping of the specified keys to Item. Constraint_Error is propagated when From > To such that Object_Type'Pred (From) /= To.

procedure Erase (Container : in out Map);

This procedure removes all items from Container.

function Find (Container : Map; Key      : Key_Type) return Integer;
function Find (Container : Map; From, To : Key_Type) return Integer;

This function is used to find an item mapping by a key or a range keys. The result is either a positive index of an range containing all keys or a negated index of the place where the item should be if it were in the set. Ranges in the map are ordered according to their lower bounds. Intersecting ranges are considered equal. Constraint_Error is propagated when From > To.

function From (Container : Map; Index : Positive) return Key_Type;
This function returns the lower bound of a range of keys the map Container using its positive index. Constraint_Error is propagated if Index is wrong.
function Get (Container : Map; Key : Key_Type) return Object_Type;
This function returns the item corresponding to the specified key. Constraint_Error is propagated if there is no such item.
procedure Get_Key
          (  Container : Map;
             Index     : Positive;
             From      : out Key_Type;
             To        : out Key_Type
          );
This function is used to get a range of keys from the map Container using a positive index. Constraint_Error is propagated if Index is wrong.

function Get_Size (Container : Map) return Natural;

This function returns the number of key ranges in the map.

function Is_Empty (Container : Map) return Boolean;

This function returns true if Container is empty.

function Is_In (Container : Map; Item     : Key_Type) return Boolean;
function
Is_In (Container : Map; From, To : Key_Type) return Boolean;

This function returns true if Item or whole From..To is in Container.

function Is_Not_In (Container : Map; From, To : Object_Type) return Boolean;

This function returns true if none of the keys from From..To is in Container. Note that it both Is_In and Is_Not_In are false when From..To contains keys from the map and keys outside it.

function Range_Get
         (  Container : Map;
            Index     : Positive;
         )  return Object_Type;
This function returns an item corresponding to the range of keys specified by its index. The ranges are enumerated using indices from 1..Get_Size. Constraint_Error is propagated if Index is wrong.

procedure Range_Remove (Container : in out Map; Index : Positive);

This procedure removes a range of keys by its index. Constraint_Error is propagated when Index does not specify any range.

procedure Range_Replace
          (  Container : in out Map;
             Index     : Positive;
             Item      : Object_Type
          );

This procedure replaces a range of keys specified by its index. Constraint_Error is propagated when Index does not specify any range.

procedure Remove (Container : in out Map; Item     : Key_Type);
procedure
Remove (Container : in out Map; From, To : Key_Type);
procedure Remove (Container : in out Map; Items    : Map);

These procedures are used to remove mappings from the set Container. An item can be removed either explicitly, or by specifying a set of items to be removed. If a particular item is not in the set, then nothing happens. When From..To is an illegal or empty range, the operation does nothing.

procedure Replace
          (  Container : in out Map;
             Key       : Key_Type;
             Item      : Object_Type
          );
procedure Replace
          (  Container : in out Map;
             From, To  : Key_Type;
             Item      : Object_Type
          );

This procedure replaces or adds to Container a key or a range of keys mapped to the Item. Constraint_Error is propagated when From > To.

procedure Replace (Container : in out Map; Items : Map);

This procedure replaces or adds all items from Items in Container.

function To (Container : Map; Index : Positive) return Key_Type;

This function returns the upper bound of a range of keys from the set Container using its positive index. Constraint_Error is propagated if Index is wrong.

function "=" (Left, Right : Map) return Boolean;

This function returns true is if both parameters map same keys to same items.

3.2.3. Maps of discrete keys to indefinite objects

The package Generic_Discrete_Indefinite_Map is exactly like Generic_Discrete_Map but allows mapping to the objects of indefinite types (e.g. String):

generic
   type Key_Type is (<>);
   type Object_Type (<>) is private;
   Minimal_Size : Positive := 64;
   Increment    : Natural  := 50;
package Generic_Discrete_Indefinite_Map is
   type
Map is new Ada.Finalization.Controlled with private;
   ...

The implementation tries to reuse allocated objects where possible using a reference counting scheme. Thus the same object can be referenced by several ranges of keys. If this behaviour is undesirable, Generic_Indefinite_Map should be used instead. The latter has a separate object for each key.

3.2.4. Bounded maps

The package Generic_Bounded_Map provides maps of fixed size. When a new item is added to the map and the map is full an item from a map's end is removed to make place. The map is effective when items added are almost ordered by ascending or descending keys. A good example is time-stamped measurements with time stamp as the key. Then the map acts as a LIFO searchable ring buffer.

generic
   type Key_Type is (<>);
   type Object_Type is private;
   with function "<" (Left, Right : Key_Type) return Boolean is <>;
   with function
"=" (Left, Right : Key_Type) return Boolean is <>;
 package
Generic_Bounded_Map is
   type
Overriding_Policy is (Override_Least, Override_Greatest);
   type
Map (Size : Positive) is new Ada.Finalization.Controlled with private;
   ...

Here:

The following operations are defined on the type Map:

procedure Add
          (  Container : in out Map;
             Key       : Key_Type;
             Item      : Object_Type;
             Override  : Overriding_Policy;
          );
procedure Add
          (  Container : in out Map;
             Key       : Key_Type;
             Item      : Object_Type;
             Override  : Overriding_Policy;
             Index     : out Positive
          );

This procedure adds Item with Key to the map. The parameter Policy determines which item to replace when the map is full. It is ignored when the new item is added to a map's end. In that case always an item from the opposite end is dropped. Constraint_Error is propagated when the map already contains an item with the same Key. The parameter Index if used specifies the location of the newly inserted item in the range 1..Get_Size.

procedure Erase (Container : in out Map);

This procedure removes all items from Container.

function Find (Container : Map; Key : Key_Type) return Integer;

This function is used to find an item mapping by a key. The result is either a positive index of the item or a negated index of the place where the item should be if it were in the map. Items in the map are ordered by their keys. They are enumerated from 1 to Get_Size.

function Get (Container : Map; Key : Key_Type) return Object_Type;
This function returns the item corresponding to the specified key. Constraint_Error is propagated if there is no such item.
function Get_Key (Container : Map; Index : Positive) return Key_Type;
This function is used to get the key of an item by its positive index 1..Get_Size. Constraint_Error is propagated if Index is wrong.

function Get_Size (Container : Map) return Natural;

This function returns the number elements in the map.

function Inf (Container : Map; Key : Key_Type) return Natural;

This function returns index of the item that has the key less than or equal to Key. The result is 0 when there is no such item.

function Is_Empty (Container : Map) return Boolean;

This function returns true if Container is empty.

function Is_In (Container : Map; Key : Key_Type) return Boolean;

This function returns true if there is an item with the key specified by the parameter Key is in Container.

function Is_Full (Container : Mapreturn Boolean;

This function returns true if Container is full.

procedure Remove (Container : Map; Key : Key_Type);

This procedure removes an item by its key. Nothing happens if there is not such item.

procedure Remove (Container : Map; Index : Positive);

This procedure removes an item by its index. Constraint_Error is propagated when Index is wrong.
procedure Replace
          (  Container : in out Map;
             Key       : Key_Type;
             Item      : Object_Type;
             Override  : Overriding_Policy
          );
procedure Replace
          (  Container : in out Map;
             Key       : Key_Type;
             Item      : Object_Type;
             Override  : Overriding_Policy;
             Index     : out Positive
          );

This procedure adds Item with Key to the map. The parameter Policy determines which item to replace when the map is full. It is ignored when the item is added to a map's end. In that case always an item from the opposite end is dropped. When the map already contains an item with the same Key the old item is replaced. The parameter Index if used specifies the location of the newly inserted or replaced item in the range 1..Get_Size.

procedure Replace
          (  Container : in out Map;
             Key       : Key_Type;
             Index     : Positive
          );

This procedure replaces the item by its positive index in the range 1..Get_Size. Constraint_Error is propagated if Index is wrong.

function Sup (Container : Map; Key : Key_Type) return Natural;

This function returns index of the item that has the key greater than or equal to Key. The result is 0 when there is no such item.

function "<"  (Left : Key_Type, Right : Map) return Boolean;
function "<=" (Left : Key_Type, Right : Map) return Boolean;
function
">=" (Left : Key_Type, Right : Map) return Boolean;
function ">"  (Left : Key_Type, Right : Map) return Boolean;

These functions compare key with the keys of items in the map. The result is true when the map is empty.

function "<"  (Left : Map, Right : Key_Type) return Boolean;
function "<=" (Left : Map, Right : Key_Type) return Boolean;
function
">=" (Left : Map, Right : Key_Type) return Boolean;
function ">"  (Left : Map, Right : Key_Type) return Boolean;

These functions compare key with the keys of items in the map. The result is false when the map is empty.

3.2.4. Bounded maps of indefinite keys and objects

The package Generic_Bounded_Indefinite_Map is exactly like Generic_Bounded_Map but allows mapping to the objects of indefinite types (e.g. String):

generic
   type Key_Type (<>) is private;
   type Object_Type (<>) is private;
package Generic_Bounded_Indefinite_Map is
   type
Map (Size : Positive) is new Ada.Finalization.Controlled with private;
   ...

[Back][TOC][Next]

3.3. B-trees

B-tree is a map effective for large sets of keys and values allocated in a storage supporting random access to the fixed blocks of memory.

B-trees are used for implementation of file systems and databases. A B-tree is kept balanced. Each tree node has a bounded number of keys. The node keys and values are sorted and kept in a single storage bucket. Binary search is used within the bucket. Keys of the non-leaf nodes have children nodes. Keys of such nodes may have up to two children nodes on its left and right. The left child node and its children nodes contain keys lesser than the key itself. The right one contains the greater keys. The adjacent keys in the bucket share the child node. The child node of the adjacent pair contains the right child of the first key of the pair and the left child of the second key of the pair. The keys of subtree rooted in the child are greater than the first key and lesser than the second key. Each child node keeps an upward link to its parent. The keys of the tree can be effectively traversed in ascending and descending order. Furthermore shallow traversal allows logarithmic search and rendering the values on large intervals of keys provided additional information hashed in the tree buckets.

In-memory B-trees:

External B-trees in the persistent storage:

The buckets of persistent storage have the size best fit for the persistent storage block. When a streamed version is used keys and values may be larger than the block (see persistent pool streams).

3.3.1. B-trees of definite keys and objects

The generic package Generic_B_Tree provides an implementation of B-trees with definite keys and values. The package formal parameters are:

generic
   type Key_Type    is private;
   type Object_Type is private;
   type Tag_Type    is private;
   Initial_Tag : Tag_Type;
   Width       : Positive := 256;
   with function "<" (Left, Right : Key_Type) return Boolean is <>;
   with function "=" (Left, Right : Key_Type) return Boolean is <>;
package Generic_B_Tree is ...

The generic formal parameters are:

The type of the B-tree is declared as

type B_Tree is new Ada.Finalization.Limited_Controlled with private;

The following operations are defined on the type:

procedure Add
          (  Container : in out B_Tree;
             Key       : Key_Type;
             Value     : Object_Type
          );

This procedure adds new key-value pair to the tree. Constraint_Error is propagated when Key is already present in the tree.

procedure Erase (Container : in out B_Tree);

This procedure removes all pairs from the tree.

procedure Finalize (Container : in out B_Tree);

This procedure, when overridden in the child type must be called from the new implementation.

function Find (Container : B_Tree; Key : Key_Type) return Item_Ptr;

This function is used to search the tree for given key. The result is a pointer to the found key-value pair or No_Item if the key is not in the tree.

function Get (Container : B_Tree; Key : Key_Type) return Object_Type;

This function is returns the value associated with the key. Constraint_Error is propagated when the key is not in the tree.

function Get_First (Container : B_Tree) return Item_Ptr;

This function returns a pointer to the key-value pair with the least key. The result is No_Item if the tree is empty.

function Get_Last (Container : B_Tree) return Item_Ptr;

This function returns a pointer to the key-value pair with the greatest key. The result is No_Item if the tree is empty.

function Get_Root (Container : B_Tree) return Item_Ptr;

The result is the first item in the root bucket or No_Item.

function Inf (Container : B_Tree; Key : Key_Type) return Item_Ptr;

This function returns a pointer to the key-value pair with the key less than or equal to Key. The result is No_Item if the tree is empty.

function Is_Empty (Container : B_Tree) return Boolean;

This function returns true if the tree is empty.

function Is_In (Container : B_Tree; Key : Key_Type) return Boolean;

This function returns true if Key is in the tree.

procedure Remove
          (  Container : in out B_Tree;
             Key       : Key_Type
          );

This procedure removes a key-value pair by the key. Nothing happens if the key is not in the tree.

procedure Replace
          (  Container : in out B_Tree;
             Key       : Key_Type;
             Value     : Object_Type
          );

This procedure adds new key-value pair if Key is not in the tree or else replaces the value in the pair if the Key is already in the tree.

function Sup (Container : B_Tree; Key : Key_Type) return Item_Ptr;

This function returns a pointer to the key-value pair with the key greater than or equal to Key. The result is No_Item if the tree is empty.

function "=" (Left, Right : B_Tree) return Boolean;

This function returns true if both trees contains same sets of key-value pairs.

Pointers to the key-value pairs. The type Item_Ptr is used to point a key-value pair in the tree:

type Item_Ptr is private;
No_Item : constant Item_Ptr;

The value No_Item is used to indicate no item. Note that key-value pointers are volatile, any tree update operation can potentially invalidate any pointer. The following operations are defined on pointers:

function Get_Bucket_Address (Item : Item_Ptr) return System.Address;

This function returns the address of the bucket pointed by Item. The result is Null_Address when Item is No_Item.

function Get_Bucket_Size (Item : Item_Ptr) return Natural;

This function returns the number of used slots in the bucket. The result is 0 when Item is No_Item.

function Get_First (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the child key-value pair with the least key. The result is No_Item if Item is.

function Get_Index (Item : Item_Ptr) return Positive;

This function returns the position in the bucket of the key-value pair pointed by Item. The result is in the range 1..Get_Size (Item). Constraint_Error is propagated when Item is No_Item.

function Get_Item (Item : Item_Ptr; Index : Positive) return Item_Ptr;

This function returns a pointer to the item in the same bucket as Item at the position specified by Index. Items in the bucket are ordered by their keys. The number of items is returned by Get_Bucket_Size. The result is No_Item when there is no such pair.

function Get_Key (Item : Item_Ptr) return Key_Type;

This function returns the key in the key-value pair pointed by Item. Constraint_Error is propagated when Item is No_Item.

function Get_Last (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the child key-value pair with the greatest key. The result is No_Item if Item is.

function Get_Left_Child (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the key-value pair from the child bucket with the greatest key in the bucket. It is less than the key in the pair. The result No_Item when there is no such pair.

function Get_Left_Parent (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the key-value pair from the parent bucket with the key less than the key in the pair. The result No_Item when there is no such pair.

function Get_Next (Item : Item_Ptr) return Item_Ptr;

This function returns the pointer to the next key-value pair. The result No_Item when there is no such pair.

function Get_Parent (Item : Item_Ptr) return Item_Ptr;

This function returns the pointer to the parent key-value pair. The result No_Item when there is no such pair.

function Get_Previous (Item : Item_Ptr) return Item_Ptr;

This function returns the pointer to the previous key-value pair. The result No_Item when there is no such pair.

function Get_Right_Child (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the key-value pair from the child bucket with the least key in the bucket. It is greater than the key in the pair. The result No_Item when there is no such pair.

function Get_Right_Parent (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the key-value pair from the parent bucket with the key greater than the key in the pair. The result No_Item when there is no such pair.

function Get_Root (Item : Item_Ptr) return Item_Ptr;

This function returns the pointer to the first key-value pair in the root bucket. The result No_Item when there is no such pair.

function Get_Tag (Item : Item_Ptr) return Tag_Type;

This function returns the tag associated with the bucket indicated by Item. The tag can be set using Set_Tag. Initially the bucket tag is set to zero. Constraint_Error is propagated when Item is No_Item.

function Get_Value (Item : Item_Ptr) return Object_Type;

This function returns the value in the key-value pair pointed by Item. Constraint_Error is propagated when Item is No_Item.

procedure Remove (Item : in out Item_Ptr);

This procedure removes the key-value pair pointed by Item. Constraint_Error is propagated when Item is No_Item. After removal Item is set to No_Item.

procedure Replace (Item : in out Item_Ptr; Value : Object_Type);

This procedure changes the value in the key-value pair pointed by Item. Constraint_Error is propagated when Item is No_Item.

procedure Set_Tag (Item : Item_Ptr; Tag : Tag_Type);

This procedure sets the tag for the bucket indicated by Item. Constraint_Error is propagated when Item is No_Item.

type Bucket_Traversal is (Quit, Step_Over, Step_In);
generic
   with function
Visit_Item
                 (  Container : B_Tree;
                    Key       : Key_Type;
                    Item      : Item_Ptr
                 )  return Boolean is <>;
   with function Visit_Range
                 (  Container : B_Tree;
                    Item      : Item_Ptr
                 )  return Bucket_Traversal is <>;
procedure Generic_Traverse
          (  Container : B_Tree;
             From      : Item_Ptr;
             To        : Key_Type
          );

This generic procedure traverses items of the tree starting at From and less than or equal to To in ascending order of keys. The traversal is shallow or deep controlled by the visitor function. If a bucket contains items with the keys in the range, which includes items of all subtrees, then it is visited as a whole once or looked into. There are two visitor functions:

function Visit_Range
         (  Container : B_Tree;
            Item      : Item_Ptr
         )  return Bucket_Traversal;

This function is called for each bucket of items within the range From..To. An item from the bucket is passed to identify it. For the purpose of searching the tree the bucket tag may keep hashed data for the bucket (see Set_Tag). The function returns:

function Visit_Item
         (  Container : B_Tree;
            Key       : Key_Type;
            Item      : Item_Ptr
         )  return Boolean;

This function is called for each tree item that is not in a bucket for which the range function is called. It passes the item and its key. The function returns false to immediately stop traversal.

procedure Traverse
          (  Container : B_Tree;
             Iterator  : in out Abstract_Visitor'Class;
             From      : Item_Ptr;
             To        : Key_Type
          );

This procedure is a non-generic variant of Generic_Traverse. It uses an instance of a type derived from Abstract_Visitor which implements visitor functions as primitive operation:

type Abstract_Visitor is abstract
   new
Ada.Finalization.Limited_Controlled with null record;
function Visit_Item
         (  Iterator  : access Abstract_Visitor;
            Container : B_Tree'Class;
            Key       : Key_Type;
            Item      : Item_Ptr
         )  return Boolean is abstract;
function Visit_Range
         (  Iterator  : access Abstract_Visitor;
            Container : B_Tree'Class;
            Item      : Item_Ptr
         )  return Bucket_Traversal is abstract;

3.3.2. B-trees of indefinite keys and objects

The package Generic_Indefinite_B_Tree is exactly as Generic_B_Tree except that it allows indefinite key and object types used in an instantiation:

generic
   type Key_Type    (<>) is private;
   type Object_Type (<>) is private;
   type Tag_Type    (<>) is private;
   Width : Positive := 256;
   with function "<" (Left, Right : Key_Type) return Boolean is <>;
   with function "=" (Left, Right : Key_Type) return Boolean is <>;
package Generic_B_Tree is ...

The generic formal parameters are:

3.3.3 Persistent B-trees

The generic child package Persistent.Memory_Pools.Streams.Generic_External_B_Tree provides B-trees resident in a persistent memory pool. When the tree is updated the changes are kept in the storage. The tree object can then be finalized and the storage file closed. When the storage is re-opened the tree object can be created new and bound to the stored content (see Set_Root_Address and Get_Root_Address).

The implementation of the package is task-safe, the B-tree object can be concurrently accessed from several tasks.

The package formal parameters are:

generic
   type Key_Type (<>) is private;
   type Object_Type (<>) is private;
   with function Input_Key
                 (  Stream : access Root_Stream_Type'Class
                 )  return Key_Type is <>;
   with function Input_Value
                 (  Stream : access Root_Stream_Type'Class
                 )  return Object_Type is <>;
   with procedure Output_Key
                  (  Stream : access Root_Stream_Type'Class;
                     Key    : Key_Type
                  )  is <>;
   with procedure Output_Value
                  (  Stream : access Root_Stream_Type'Class;
                     Value  : Object_Type
                  )  is <>;
   with function "<" (Left, Right : Key_Type) return Boolean is <>;
   with function "=" (Left, Right : Key_Type) return Boolean is <>;
package Persistent.Memory_Pools.Streams.Generic_External_B_Tree is ...

The generic formal parameters are:

The type of the B-tree is declared as:

type B_Tree
     (  Pool : access Persistent_Pool'Class
     )  is new Ada.Finalization.Limited_Controlled with private;

Here Pool is the persistent memory to allocate the tree in. The following operations are defined on the type:

procedure Add
          (  Container : in out B_Tree;
             Key       : Key_Type;
             Value     : Object_Type
          );

This procedure adds new key-value pair to the tree. Constraint_Error is propagated when Key is already present in the tree.

procedure Add
          (  Container : in out B_Tree;
             Key       : Key_Type;
             Producer  : in out Abstract_Value_Access'Class
          );

This variant of the procedure uses Producer object's operation Put to store the value for the added key.

procedure Erase (Container : in out B_Tree);

This procedure removes all key-value pairs from the tree.

procedure Finalize (Container : in out B_Tree);

This procedure, when overridden in the child type must be called from the new implementation.

function Find (Container : B_Tree; Key : Key_Type) return Item_Ptr;

This function is used to search the tree for given key. The result is a pointer to the found key-value pair or No_Item if the key is not in the tree.

function Get (Container : B_Tree; Key : Key_Type) return Object_Type;

This function is returns the value associated with the key. Constraint_Error is propagated when the key is not in the tree.

procedure Get
          (  Container : in out B_Tree;
             Key       : Key_Type;
             Consumer  : in out Abstract_Value_Access'Class
          );

This variant uses Consumer object's operation Get to obtain the value corresponding to Key.

function Get_First (Container : B_Tree) return Item_Ptr;

This function returns a pointer to the key-value pair with the least key. The result is No_Item if the tree is empty.

function Get_Last (Container : B_Tree) return Item_Ptr;

This function returns a pointer to the key-value pair with the greatest key. The result is No_Item if the tree is empty.

function Get_Root (Container : B_Tree) return Item_Ptr;

The result is the first item in the root bucket or No_Item.

function Get_Root_Address (Container : B_Tree) return Byte_Index;

The result of this function is the byte index of the root bucket of the tree. Note that the index may change as the tree gets updated.

function Inf (Container : B_Tree; Key : Key_Type) return Item_Ptr;

This function returns a pointer to the key-value pair with the key less than or equal to Key. The result is No_Item if there is no such pair.

procedure Initialize (Container : in out B_Tree);

This procedure, when overridden in the child type must be called from the new implementation.

function Is_Empty (Container : B_Tree) return Boolean;

This function returns true if the tree is empty.

function Is_In (Container : B_Tree; Key : Key_Type) return Boolean;

This function returns true if Key is in the tree.

procedure Remove
          (  Container : in out B_Tree;
             Key       : Key_Type
          );

This procedure removes a key-value pair by the key. Nothing happens if the key is not in the tree.

procedure Replace
          (  Container : in out B_Tree;
             Key       : Key_Type;
             Value     : Object_Type
          );

This procedure adds new key-value pair if Key is not in the tree or else replaces the value in the pair if the Key is already in the tree.

procedure Replace
          (  Container : in out B_Tree;
             Key       : Key_Type;
             Producer  : in out Abstract_Value_Access'Class
          );

This variant of the procedure uses Producer object's operation Put to update or store the value for the added or existing key.

procedure Restore
          (  Container : in out B_Tree;
             Reference : Byte_Index
          );

This procedure restores tree previously stored using Store. Reference is the value returned by Store. Status_Error is propagated when the tree is not empty.

procedure Set_Root_Address
          (  Container : in out B_Tree;
             Root      : Byte_Index
          );

This procedure sets the byte index of the tree root. Status_Error is propagated when the tree is not empty.

procedure Store
          (  Container : in out B_Tree;
             Reference : out Byte_Index
          );

This procedure stores the tree. Unless called the tree is removed upon finalization. After Store completion the tree is empty. It can be restored by calling to Restore and passing the returned Reference. The value must be kept between the sessions for instance in a memory pool root index (See Get_Root_Index and Set_Root_Index).

function Sup (Container : B_Tree; Key : Key_Type) return Item_Ptr;

This function returns a pointer to the key-value pair with the key greater than or equal to Key. The result is No_Item if there is no such pair.

Pointers to the key-value pairs. The type Item_Ptr is used to point a key-value pair in the tree:

type Item_Ptr is private;
No_Item : constant Item_Ptr;

The value No_Item is used to indicate no item. Note that key-value pointers are volatile, any tree update operation can potentially invalidate any pointer. The following operations are defined on the key-value pointer:

function Get_Bucket_Address (Item : Item_Ptr) return Byte_Index;

This function returns the address of the bucket pointed by Item. The result is 0 when Item is No_Item.

function Get_Bucket_Size (Item : Item_Ptr) return Natural;

This function returns the number of used slots in the bucket. The result is 0 when Item is No_Item.

function Get_First (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the child key-value pair with the least key. The result is No_Item if Item is.

function Get_Index (Item : Item_Ptr) return Positive;

This function returns the position in the bucket of the key-value pair pointed by Item. The result is in the range 1..Get_Bucket_Size (Item). Constraint_Error is propagated when Item is No_Item.

function Get_Item (Item : Item_Ptr; Index : Positive) return Item_Ptr;

This function returns a pointer to the item in the same bucket as Item at the position specified by Index. Items in the bucket are ordered by their keys. The number of items is returned by Get_Bucket_Size. The result is No_Item when there is no such pair.

function Get_Key (Item : Item_Ptr) return Key_Type;

This function returns the key in the key-value pair pointed by Item. Constraint_Error is propagated when Item is No_Item.

function Get_Key_Address (Item : Item_Ptr) return Byte_Index;

This function returns the address of the key in the key-value pair pointed by Item. Constraint_Error is propagated when Item is No_Item.

function Get_Last (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the child key-value pair with the greatest key. The result is No_Item if Item is.

function Get_Left_Child (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the key-value pair from the child bucket with the greatest key in the bucket. It is less than the key in the pair. The result No_Item when there is no such pair.

function Get_Left_Parent (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the key-value pair from the parent bucket with the key less than the key in the pair. The result No_Item when there is no such pair.

function Get_Next (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the next key-value pair. The result No_Item when there is no such pair.

function Get_Parent (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the parent key-value pair. The result No_Item when there is no such pair.

function Get_Previous (Item : Item_Ptr) return Item_Ptr;

This function returns the pointer to the previous key-value pair. The result No_Item when there is no such pair.

function Get_Right_Child (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the key-value pair from the child bucket with the least key in the bucket. It is greater than the key in the pair. The result No_Item when there is no such pair.

function Get_Right_Parent (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the key-value pair from the parent bucket with the key greater than the key in the pair. The result No_Item when there is no such pair.

function Get_Root (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the first key-value pair in the root bucket. The result No_Item when there is no such pair.

function Get_Tag (Item : Item_Ptr) return Byte_Index;

This function returns the tag associated with the bucket indicated by Item. The tag can be set using Set_Tag. Initially the bucket tag is set to zero. Constraint_Error is propagated when Item is No_Item.

function Get_Value (Item : Item_Ptr) return Object_Type;

This function returns the value in the key-value pair pointed by Item. Constraint_Error is propagated when Item is No_Item.

procedure Get_Value
          (  Item     : Item_Ptr;
             Consumer : in out Abstract_Value_Access'Class
          );

This variant uses Consumer object's operation Get to obtain the value of the key-value pair. Constraint_Error is propagated when Item is No_Item.

function Get_Value_Address (Item : Item_Ptr) return Byte_Index;

This function returns the address of the value in the key-value pair pointed by Item. Constraint_Error is propagated when Item is No_Item.

procedure Remove (Item : in out Item_Ptr);

This procedure removes the key-value pair pointed by Item. Constraint_Error is propagated when Item is No_Item. After removal Item is set to No_Item.

procedure Replace (Item : in out Item_Ptr; Value : Object_Type);

This procedure changes the value in the key-value pair pointed by Item. Constraint_Error is propagated when Item is No_Item.

procedure Replace
          (  Item     : Item_Ptr;
             Producer : in out Abstract_Value_Access'Class
          );

This variant of the procedure uses Producer object's operation Put to update or store the value for the added or existing key.

procedure Set_Tag (Item : Item_Ptr; Tag : Byte_Index);

This procedure sets the tag for the bucket indicated by Item. Constraint_Error is propagated when Item is No_Item.

Stream access to values. The type:

type Abstract_Value_Access is abstract
   new
Ada.Finalization.Limited_Controlled with null record;

is used to access values of the key-value pair in the tree using a stream object. The type declares two abstract primitive operations to implement:

procedure Get
          (  Consumer : in out Abstract_Value_Access;
             Stream   : in out Root_Stream_Type'Class
          )  is abstract;

This procedure is called when the value of the key-value pair has to be read from the B-tree. The parameter Consumer is the user-defined object passed to the tree operation getting the value. Stream is the stream to read the value from, e.g. using Object_Type'Input attribute (provided Object_Type'Output was used to store the value). Note that Input_Value and Output_Value generic formal parameters of the package are used to access the value in other cases. The method chosen in Get must be compatible with those.

procedure Put
          (  Producer : in out Abstract_Value_Access;
             Stream   : in out Root_Stream_Type'Class
          )  is abstract;

This procedure is called when the value of the key-value pair has to be written into the B-tree. The parameter Producer is the user-defined object passed to the tree operation getting the value. Stream is the stream to write the value into, e.g. using Object_Type'Output attribute Note that Input_Value and Output_Value generic formal parameters of the package are used to access the value in other cases. The method chosen in Put must be compatible with those.

type Bucket_Traversal is (Quit, Step_Over, Step_In);
generic
   with function
Visit_Item
                 (  Container : B_Tree;
                    Key       : Key_Type;
                    Item      : Item_Ptr
                 )  return Boolean is <>;
   with function Visit_Range
                 (  Container : B_Tree;
                    Item      : Item_Ptr
                 )  return Bucket_Traversal is <>;
procedure Generic_Traverse
          (  Container : B_Tree;
             From      : Item_Ptr;
             To        : Key_Type
          );

This generic procedure traverses items of the tree starting at From and less than or equal to To in ascending order of keys. The traversal is shallow or deep controlled by the visitor function. If a bucket contains items with the keys in the range, which includes items of all subtrees, then it is visited as a whole once or looked into. There are two visitor functions:

 The traversal is shallow or deep controlled by the visitor function. If a bucket contains items with the keys in the range, which includes items of all subtrees, then it is visited as a whole once or looked into. There are two visitor functions:

function Visit_Range
         (  Container : B_Tree;
            Item      : Item_Ptr
         )  return Bucket_Traversal;

This function is called for each bucket of items within the range From..To. An item from the bucket is passed to identify it. For the purpose of searching the tree the bucket tag may keep hashed data for the bucket (see Set_Tag). The function returns:

function Visit_Item
         (  Container : B_Tree;
            Key       : Key_Type;
            Item      : Item_Ptr
         )  return Boolean;

This function is called for each tree item that is not in a bucket for which the range function is called. It passes the item and its key. The function returns false to immediately stop traversal.

procedure Traverse
          (  Container : B_Tree;
             Iterator  : in out Abstract_Visitor'Class;
             From      : Item_Ptr;
             To        : Key_Type
          );

This procedure is a non-generic variant of Generic_Traverse. It uses an instance of a type derived from Abstract_Visitor which implements visitor functions as primitive operation:

type Abstract_Visitor is abstract
   new
Ada.Finalization.Limited_Controlled with null record;
function Visit_Item
         (  Iterator  : access Abstract_Visitor;
            Container : B_Tree'Class;
            Key       : Key_Type;
            Item      : Item_Ptr
         )  return Boolean is abstract;
function Visit_Range
         (  Iterator  : access Abstract_Visitor;
            Container : B_Tree'Class;
            Item      : Item_Ptr
         )  return Bucket_Traversal is abstract;

3.3.4 Persistent pointer-valued B-trees

The generic child package Persistent.Memory_Pools.Streams.Generic_External_Ptr_B_Tree provides a variant of the persistent B-tree with pointers as values. Instead of a custom value type as in Generic_External_B_Tree this tree maps key to plain persistent pointers of the Byte_Index type.

The implementation of the package is task-safe, the B-tree object can be concurrently accessed from several tasks.

The package formal parameters are:

generic
   type Key_Type (<>) is private;
   with function Input_Key
                 (  Stream : access Root_Stream_Type'Class
                 )  return Key_Type is <>;
   with procedure Output_Key
                  (  Stream : access Root_Stream_Type'Class;
                     Key    : Key_Type
                  )  is <>;
   with function "<" (Left, Right : Key_Type) return Boolean is <>;
   with function "=" (Left, Right : Key_Type) return Boolean is <>;
package Persistent.Memory_Pools.Streams.Generic_External_Ptr_B_Tree is ...

The generic formal parameters are:

The type of the B-tree is declared as:

type B_Tree
     (  Pool : access Persistent_Pool'Class
     )  is new Ada.Finalization.Limited_Controlled with private;

Here Pool is the persistent memory to allocate the tree in. The following operations are defined on the type:

procedure Add
          (  Container : in out B_Tree;
             Key       : Key_Type;
             Pointer   : Byte_Index
          );

This procedure adds new key-pointer pair to the tree. Constraint_Error is propagated when Key is already present in the tree.

procedure Erase (Container : in out B_Tree);

This procedure removes all key-pointer pairs from the tree.

procedure Finalize (Container : in out B_Tree);

This procedure, when overridden in the child type must be called from the new implementation.

function Find (Container : B_Tree; Key : Key_Type) return Item_Ptr;

This function is used to search the tree for given key. The result is a pointer to the found key-value pair or No_Item if the key is not in the tree.

function Get (Container : B_Tree; Key : Key_Type) return Byte_Index;

This function is returns the pointer associated with the key. Constraint_Error is propagated when the key is not in the tree.

function Get_First (Container : B_Tree) return Item_Ptr;

This function returns a pointer to the key-pointer pair with the least key. The result is No_Item if the tree is empty.

function Get_Last (Container : B_Tree) return Item_Ptr;

This function returns a pointer to the key-pointer pair with the greatest key. The result is No_Item if the tree is empty.

function Get_Root (Container : B_Tree) return Item_Ptr;

The result is the first item in the root bucket or No_Item.

function Get_Root_Address (Container : B_Tree) return Byte_Index;

The result of this function is the byte index of the root bucket of the tree. Note that the index may change as the tree gets updated.

function Inf (Container : B_Tree; Key : Key_Type) return Item_Ptr;

This function returns a pointer to the key-pointer pair with the key less than or equal to Key. The result is No_Item if there is no such pair.

procedure Initialize (Container : in out B_Tree);

This procedure, when overridden in the child type must be called from the new implementation.

function Is_Empty (Container : B_Tree) return Boolean;

This function returns true if the tree is empty.

function Is_In (Container : B_Tree; Key : Key_Type) return Boolean;

This function returns true if Key is in the tree.

procedure Remove
          (  Container : in out B_Tree;
             Key       : Key_Type
          );
procedure
Remove
          (  Container : in out B_Tree;
             Key       : Key_Type;
             Pointer   : out Byte_Index
          );

This procedure removes a key-pointer pair by the key. Nothing happens if the key is not in the tree. When the output parameter Pointer is specified it is set to the pointer from the removed pair. If no pair was removed Pointer is set to 0.

procedure Replace
          (  Container : in out B_Tree;
             Key       : Key_Type;
             Pointer   : Byte_Index
          );
procedure
Replace
          (  Container : in out B_Tree;
             Key       : Key_Type;
             Pointer   : Byte_Index;
             Replaced  : out Byte_Index
          );

This procedure adds new key-pointer pair if Key is not in the tree or else replaces the pointer  in the pair if the Key is already in the tree. When the parameter Replaced is specified it is set to the old pointer if the pair was replaced. If the pair was added Replaced is set to 0.

procedure Restore
          (  Container : in out B_Tree;
             Reference : Byte_Index
          );

This procedure restores tree previously stored using Store. Reference is the value returned by Store. Status_Error is propagated when the tree is not empty.

procedure Set_Root_Address
          (  Container : in out B_Tree;
             Root      : Byte_Index
          );

This procedure sets the byte index of the tree root. Status_Error is propagated when the tree is not empty.

procedure Store
          (  Container : in out B_Tree;
             Reference : out Byte_Index
          );

This procedure stores the tree. Unless called the tree is removed upon finalization. After Store completion the tree is empty. It can be restored by calling to Restore and passing the returned Reference. The value must be kept between the sessions for instance in a memory pool root index (See Get_Root_Index and Set_Root_Index).

function Sup (Container : B_Tree; Key : Key_Type) return Item_Ptr;

This function returns a pointer to the key-pointer pair with the key greater than or equal to Key. The result is No_Item if there is no such pair.

Pointers to the key-value pairs. The type Item_Ptr is used to point a key-value pair in the tree:

type Item_Ptr is private;
No_Item : constant Item_Ptr;

The value No_Item is used to indicate no item. Note that key-pointer pointers are volatile, any tree update operation can potentially invalidate any pointer. The following operations are defined on the key-pointer pointer:

function Get_Bucket_Address (Item : Item_Ptr) return Byte_Index;

This function returns the address of the bucket pointed by Item. The result is 0 when Item is No_Item.

function Get_Bucket_Size (Item : Item_Ptr) return Natural;

This function returns the number of used slots in the bucket. The result is 0 when Item is No_Item.

function Get_First (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the child key-value pair with the least key. The result is No_Item if Item is.

function Get_Index (Item : Item_Ptr) return Positive;

This function returns the position in the bucket of the key-pointer pair pointed by Item. The result is in the range 1..Get_Bucket_Size (Item). Constraint_Error is propagated when Item is No_Item.

function Get_Item (Item : Item_Ptr; Index : Positive) return Item_Ptr;

This function returns a pointer to the item in the same bucket as Item at the position specified by Index. Items in the bucket are ordered by their keys. The number of items is returned by Get_Bucket_Size. The result is No_Item when there is no such pair.

function Get_Key (Item : Item_Ptr) return Key_Type;

This function returns the key in the key-pointer pair pointed by Item. Constraint_Error is propagated when Item is No_Item.

function Get_Key_Address (Item : Item_Ptr) return Byte_Index;

This function returns the address of the key in the key-value pair pointed by Item. Constraint_Error is propagated when Item is No_Item.

function Get_Last (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the child key-value pair with the greatest key. The result is No_Item if Item is.

function Get_Left_Child (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the key-value pair from the child bucket with the greatest key in the bucket. It is less than the key in the pair. The result No_Item when there is no such pair.

function Get_Left_Parent (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the key-value pair from the parent bucket with the key less than the key in the pair. The result No_Item when there is no such pair.

function Get_Next (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the next key-pointer pair. The result No_Item when there is no such pair.

function Get_Pointer (Item : Item_Ptr) return Byte_Index;

This function returns the pointer from the key-pointer pair pointed by Item. Constraint_Error is propagated when Item is No_Item.

function Get_Previous (Item : Item_Ptr) return Item_Ptr;

This function returns the pointer to the previous key-value pair. The result No_Item when there is no such pair.

function Get_Right_Child (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the key-value pair from the child bucket with the least key in the bucket. It is greater than the key in the pair. The result No_Item when there is no such pair.

function Get_Right_Parent (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the key-value pair from the parent bucket with the key greater than the key in the pair. The result No_Item when there is no such pair.

function Get_Root (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the first key-pointer pair in the root bucket. The result No_Item when there is no such pair.

function Get_Tag (Item : Item_Ptr) return Byte_Index;

This function returns the tag associated with the bucket indicated by Item. The tag can be set using Set_Tag. Initially the bucket tag is set to zero. Constraint_Error is propagated when Item is No_Item.

procedure Remove (Item : in out Item_Ptr);
procedure
Remove (Item : in out Item_Ptr; Pointer : out Byte_Index);

This procedure removes the key-pointer pair pointed by Item. Constraint_Error is propagated when Item is No_Item. After removal Item is set to No_Item. When the parameter Pointer is specified it accepts the pointer from the removed pair. It is set to 0 when no pair is removed.

procedure Replace
          (  Item     : in out Item_Ptr;
             Pointer  : Byte_Index
          );
procedure
Replace
          (  Item     : in out Item_Ptr;
             Pointer  : Byte_Index;
             Replaced : out Byte_Index
          );

This procedure changes the value in the key-pointer pair pointed by Item. Constraint_Error is propagated when Item is No_Item. The parameter Replaced when specified accepts the replaced pointer.

procedure Set_Tag (Item : Item_Ptr; Tag : Byte_Index);

This procedure sets the tag for the bucket indicated by Item. Constraint_Error is propagated when Item is No_Item.

type Bucket_Traversal is (Quit, Step_Over, Step_In);
generic
   with function
Visit_Item
                 (  Container : B_Tree;
                    Key       : Key_Type;
                    Item      : Item_Ptr
                 )  return Boolean is <>;
   with function Visit_Range
                 (  Container : B_Tree;
                    Item      : Item_Ptr
                 )  return Bucket_Traversal is <>;
procedure Generic_Traverse
          (  Container : B_Tree;
             From      : Item_Ptr;
             To        : Key_Type
          );

This generic procedure traverses items of the tree starting at From and less than or equal to To in ascending order of keys. The traversal is shallow or deep controlled by the visitor function. If a bucket contains items with the keys in the range, which includes items of all subtrees, then it is visited as a whole once or looked into. There are two visitor functions:

function Visit_Range
         (  Container : B_Tree;
            Item      : Item_Ptr
         )  return Bucket_Traversal;

This function is called for each bucket of items within the range From..To. An item from the bucket is passed to identify it. For the purpose of searching the tree the bucket tag may keep hashed data for the bucket (see Set_Tag). The function returns:

function Visit_Item
         (  Container : B_Tree;
            Key       : Key_Type;
            Item      : Item_Ptr
         )  return Boolean;

This function is called for each tree item that is not in a bucket for which the range function is called. It passes the item and its key. The function returns false to immediately stop traversal.

procedure Traverse
          (  Container : B_Tree;
             Iterator  : in out Abstract_Visitor'Class;
             From      : Item_Ptr;
             To        : Key_Type
          );

This procedure is a non-generic variant of Generic_Traverse. It uses an instance of a type derived from Abstract_Visitor which implements visitor functions as primitive operation:

type Abstract_Visitor is abstract
   new
Ada.Finalization.Limited_Controlled with null record;
function Visit_Item
         (  Iterator  : access Abstract_Visitor;
            Container : B_Tree'Class;
            Key       : Key_Type;
            Item      : Item_Ptr
         )  return Boolean is abstract;
function Visit_Range
         (  Iterator  : access Abstract_Visitor;
            Container : B_Tree'Class;
            Item      : Item_Ptr
         )  return Bucket_Traversal is abstract;

3.3.5 Persistent raw B-trees

The generic child package Persistent.Memory_Pools.Streams.External_B_Tree provides a variant of the persistent B-tree with weakly typed keys and values. For both the type Byte_Index is used. Usually the tree is used as private parent type for an implementation which either allocates keys and/or values in the pool and passes the resulting Byte_Index to the operations of B-tree. Alternatively it can pack key and/or value into Byte_Index if these fit into the Byte_Index's range. The ordering of keys can be changed by overriding the primitive operation Compare.

The implementation of the package is task-safe, the B-tree object can be concurrently accessed from several tasks.

The type of the B-tree is declared as:

type B_Tree
     (  Pool : access Persistent_Pool'Class
     )  is new Ada.Finalization.Limited_Controlled with private;

Here Pool is the persistent memory to allocate the tree in. The following operations are defined on the type:

procedure Add
          (  Container : in out B_Tree;
             Key       : Byte_Index;
             Value     : Byte_Index
          );

This procedure adds new key-value pair to the tree. Constraint_Error is propagated when Key is already present in the tree.

function Compare
         (  Container : B_Tree;
            Left      : Byte_Index;
            Right     : Byte_Index
         )  return Precedence;

This function is used to compare two keys. The result is of the enumeration Less, Equal, Greater defined in Strings_Edit.Lexicographical_Order. It can be overridden in order to change the ordering of keys.

procedure Erase (Container : in out B_Tree);

This procedure removes all key-value pairs from the tree.

procedure Finalize (Container : in out B_Tree);

This procedure, when overridden in the child type must be called from the new implementation.

function Find
         (  Container : B_Tree;
            Key       : Byte_Index
         )  return Item_Ptr;

This function is used to search the tree for given key. The result is a pointer to the found key-value pair or No_Item if the key is not in the tree.

function Get
         (  Container : B_Tree;
            Key       : Byte_Index
         )  return Byte_Index;

This function is returns the value associated with the key. Constraint_Error is propagated when the key is not in the tree.

function Get_First (Container : B_Tree) return Item_Ptr;

This function returns a pointer to the key-value pair with the least key. The result is No_Item if the tree is empty.

function Get_Last (Container : B_Tree) return Item_Ptr;

This function returns a pointer to the key-value pair with the greatest key. The result is No_Item if the tree is empty.

function Get_Root_Address (Container : B_Tree) return Byte_Index;

The result of this function is the byte index of the root bucket of the tree. Note that the index may change as the tree gets updated.

function Inf (Container : B_Tree; Key : Byte_Index) return Item_Ptr;

This function returns a pointer to the key-value pair with the key less than or equal to Key. The result is No_Item if there is no such pair.

procedure Initialize (Container : in out B_Tree);

This procedure, when overridden in the child type must be called from the new implementation.

function Is_Empty (Container : B_Tree) return Boolean;

This function returns true if the tree is empty.

function Is_In (Container : B_Tree; Key : Byte_Index) return Boolean;

This function returns true if Key is in the tree.

procedure Remove
          (  Container : in out B_Tree;
             Key       : Byte_Index
          );
procedure
Remove
          (  Container : in out B_Tree;
             Key       : Byte_Index;
             Value     : out Byte_Index
          );

This procedure removes a key-value pair by the key. Nothing happens if the key is not in the tree. When the output parameter Value is specified it is set to the value from the removed pair. If no pair was removed Value is set to 0.

procedure Replace
          (  Container : in out B_Tree;
             Key       : Byte_Index;
             Value     : Byte_Index
          );
procedure
Replace
          (  Container : in out B_Tree;
             Key       : Byte_Index;
             Value     : Byte_Index;
             Replaced  : out Byte_Index
          );

This procedure adds new key-value pair if Key is not in the tree or else replaces the value  in the pair if the Key is already in the tree. When the parameter Replaced is specified it is set to the old value if the pair was replaced. If the pair was added Replaced is set to 0.

procedure Restore
          (  Container : in out B_Tree;
             Reference : Byte_Index
          );

This procedure restores tree previously stored using Store. Reference is the value returned by Store. Status_Error is propagated when the tree is not empty.

procedure Set_Root_Address
          (  Container : in out B_Tree;
             Root      : Byte_Index
          );

This procedure sets the byte index of the tree root. Status_Error is propagated when the tree is not empty.

procedure Store
          (  Container : in out B_Tree;
             Reference : out Byte_Index
          );

This procedure stores the tree. Unless called the tree is removed upon finalization. After Store completion the tree is empty. It can be restored by calling to Restore and passing the returned Reference. The value must be kept between the sessions for instance in a memory pool root index (See Get_Root_Index and Set_Root_Index).

function Sup (Container : B_Tree; Key : Byte_Index) return Item_Ptr;

This function returns a pointer to the key-value pair with the key greater than or equal to Key. The result is No_Item if there is no such pair.

Pointers to the key-value pairs. The type Item_Ptr is used to point a key-value pair in the tree:

type Item_Ptr is private;
No_Item : constant Item_Ptr;

The value No_Item is used to indicate no item. Note that key-value pointers are volatile, any tree update operation can potentially invalidate any pointer. The following operations are defined on the key-value pointer:

function Get_Bucket_Address (Item : Item_Ptr) return Byte_Index;

This function returns the address of the bucket pointed by Item. The result is 0 when Item is No_Item.

function Get_Bucket_Size (Item : Item_Ptr) return Natural;

This function returns the number of used slots in the bucket. The result is 0 when Item is No_Item.

function Get_First (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the child key-value pair with the least key. The result is No_Item if Item is.

function Get_Index (Item : Item_Ptr) return Positive;

This function returns the position in the bucket of the key-value pair pointed by Item. The result is in the range 1..Get_Size (Item). Constraint_Error is propagated when Item is No_Item.

function Get_Item (Item : Item_Ptr; Index : Positive) return Item_Ptr;

This function returns a pointer to the item in the same bucket as Item at the position specified by Index. Items in the bucket are ordered by their keys. The number of items is returned by Get_Bucket_Size. The result is No_Item when there is no such pair.

function Get_Key (Item : Item_Ptr) return Byte_Index;

This function returns the key in the key-value pair pointed by Item. Constraint_Error is propagated when Item is No_Item.

function Get_Last (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the child key-value pair with the greatest key. The result is No_Item if Item is.

function Get_Left_Child (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the key-value pair from the child bucket with the greatest key in the bucket. It is less than the key in the pair. The result No_Item when there is no such pair.

function Get_Left_Parent (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the key-value pair from the parent bucket with the key less than the key in the pair. The result No_Item when there is no such pair.

function Get_Next (Item : Item_Ptr) return Item_Ptr;

This function returns the pointer to the next key-value pair. The result No_Item when there is no such pair.

function Get_Parent (Item : Item_Ptr) return Item_Ptr;

This function returns the pointer to the parent key-value pair. The result No_Item when there is no such pair.

function Get_Previous (Item : Item_Ptr) return Item_Ptr;

This function returns the pointer to the previous key-value pair. The result No_Item when there is no such pair.

function Get_Right_Child (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the key-value pair from the child bucket with the least key in the bucket. It is greater than the key in the pair. The result No_Item when there is no such pair.

function Get_Right_Parent (Item : Item_Ptr) return Item_Ptr;

This function returns a pointer to the key-value pair from the parent bucket with the key greater than the key in the pair. The result No_Item when there is no such pair.

function Get_Root (Item : Item_Ptr) return Item_Ptr;

This function returns the pointer to the first key-pointer pair in the root bucket. The result No_Item when there is no such pair.

function Get_Tag (Item : Item_Ptr) return Byte_Index;

This function returns the tag associated with the bucket indicated by Item. The tag can be set using Set_Tag. Initially the bucket tag is set to zero. Constraint_Error is propagated when Item is No_Item.

function Get_Value (Item : Item_Ptr) return Byte_Index;

This function returns the value from the key-value pair pointed by Item. Constraint_Error is propagated when Item is No_Item.

procedure Remove (Item : in out Item_Ptr);
procedure
Remove (Item : in out Item_Ptr; Value : out Byte_Index);

This procedure removes the key-value pair pointed by Item. Constraint_Error is propagated when Item is No_Item. After removal Item is set to No_Item. When the parameter Value is specified it accepts the value from the removed pair. It is set to 0 when no pair is removed.

procedure Replace
          (  Item   : in out Item_Ptr;
             Value  : Byte_Index
          );
procedure
Replace
          (  Item     : in out Item_Ptr;
             Value    : Byte_Index;
             Replaced : out Byte_Index
          );

This procedure changes the value in the key-value pair pointed by Item. Constraint_Error is propagated when Item is No_Item. The parameter Replaced when specified accepts the replaced pointer.

procedure Set_Tag (Item : Item_Ptr; Tag : Byte_Index);

This procedure sets the tag for the bucket indicated by Item. Constraint_Error is propagated when Item is No_Item.

type Bucket_Traversal is (Quit, Step_Over, Step_In);
generic
   with function
Visit_Item
                 (  Container : B_Tree;
                    Key       : Byte_Index;
                    Item      : Item_Ptr
                 )  return Boolean is <>;
   with function Visit_Range
                 (  Container : B_Tree;
                    Item      : Item_Ptr
                 )  return Bucket_Traversal is <>;
procedure Generic_Traverse
          (  Container : B_Tree;
             From      : Item_Ptr;
             To        : Byte_Index
          );

This generic procedure traverses items of the tree starting at From and less than or equal to To in ascending order of keys. The traversal is shallow or deep controlled by the visitor function. If a bucket contains items with the keys in the range, which includes items of all subtrees, then it is visited as a whole once or looked into. There are two visitor functions:

function Visit_Range
         (  Container : B_Tree;
            Item      : Item_Ptr
         )  return Bucket_Traversal;

This function is called for each bucket of items within the range From..To. An item from the bucket is passed to identify it. For the purpose of searching the tree the bucket tag may keep hashed data for the bucket (see Set_Tag). The function returns:

function Visit_Item
         (  Container : B_Tree;
            Key       : Byte_Index;
            Item      : Item_Ptr
         )  return Boolean;

This function is called for each tree item that is not in a bucket for which the range function is called. It passes the item and its key. The function returns false to immediately stop traversal.

procedure Traverse
          (  Container : B_Tree;
             Iterator  : in out Abstract_Visitor'Class;
             From      : Item_Ptr;
             To        : Byte_Index
          );

This procedure is a non-generic variant of Generic_Traverse. It uses an instance of a type derived from Abstract_Visitor which implements visitor functions as primitive operation:

type Abstract_Visitor is abstract
   new
Ada.Finalization.Limited_Controlled with null record;
function Visit_Item
         (  Iterator  : access Abstract_Visitor;
            Container : B_Tree'Class;
            Key       : Byte_Index;
            Item      : Item_Ptr
         )  return Boolean is abstract;
function Visit_Range
         (  Iterator  : access Abstract_Visitor;
            Container : B_Tree'Class;
            Item      : Item_Ptr
         )  return Bucket_Traversal is abstract;

3.3.6 Persistent multi-keyed tables

The generic child package Persistent.Memory_Pools.Streams.External_B_Tree.Generic_Table provides a table allocated in an external storage. The table can be searched by any of the keys identified by the generic formal discrete type Key_Index.

k11 k12 ... k1N v11 v12 ... v1M
k21 k22 ... k2N v21 v22 ... v2M

...

kL1 kL2 ... kLN vL1 vL2 ... vLM

Each row i of the table is associated with a tuple of unique keys (ki1, ki2, ..., kiN). Any of the keys can be used to identify the row. Additionally the row contains a tuple of  values (vi1, vi2, ..., viM) identified by the generic formal discrete type Value_Index. Internally for each type of keys has a B-tree of its own. Items of the trees point to the rows. Keys and values can be queried from the row.

The implementation is raw and untyped. All keys and values are of the type Byte_Index.

generic
   type
Key_Index is (<>);
   type Value_Index is (<>);
package Persistent.Memory_Pools.Streams.External_B_Tree.
        Generic_Table is ...
The implementation of the package is task-safe, the table object can be concurrently accessed from several tasks.

The package declares:

type Keys_Tuple is array (Key_Index) of Byte_Index;

This is the tuple of keys associated with each table row. The row is uniquely identified by any of the keys from the tuple. The table can be searched for any of the keys. The row ordering induced by a key is independent on other keys.

type Values_Tuple is array (Value_Index) of Byte_Index;

This is the tuple of data kept by each table row.

The type of the table is declared as:

type Table
     (  Pool : access Persistent_Pool'Class
     )  is new Ada.Finalization.Limited_Controlled with private;

Here Pool is the persistent memory to allocate the tree in. The following operations are defined on the type:

procedure Add
          (  Container : in out Table;
             Keys      : Keys_Tuple;
             Values    : Values_Tuple
          );

This procedure adds a new row to the table. Keys specifies the row's keys. Values does the row's data. Constraint_Error is propagated when Keys contains a key already used for a table row.

function Compare
         (  Container : Table;
            Index     : Key_Index;
            Left      : Byte_Index;
            Right     : Byte_Index
         )  return Precedence;

This function is used to compare two keys of the type specified by Index. The result is of the enumeration Less, Equal, Greater defined in Strings_Edit.Lexicographical_Order. It can be overridden in order to change the ordering of keys.

procedure Erase (Container : in out Table);

This procedure removes all table rows.

procedure Finalize (Container : in out Table);

This procedure, when overridden in the child type must be called from the new implementation. Note that Get_Root_Address should be called before object finalization and the obtained value stored somewhere else.

function Find
         (  Container : Table;
            Index     : Key_Index;
            Key       : Byte_Index
         )  return Row_Ptr;

This function is used to search the table for given key identified by its type (Index) and value (Key). The result is a pointer to the found table row or No_Row if no row was found.

function Get
         (  Container : Table;
            Index     : Key_Index;
            Key       : Byte_Index
         )  return Values_Tuple;

This function is returns the values associated with the key identified by its type (Index) and value (Key). Constraint_Error is propagated when the row does not exist.

function Get
         (  Container : Table;
            Index     : Key_Index;
            Key       : Byte_Index;
            Column    : Value_Index
         )  return Byte_Index;

This function is returns the value associated with the key identified by its type (Index) and value (Key) from the column specified by the parameter Column. Constraint_Error is propagated when the row does not exist.

function Get_First
         (  Container : Table;
            Index
     : Key_Index
         )  return Row_Ptr;

This function returns a pointer to the row with the least key. The parameter Index specifies the key type. The result is No_Row if the table is empty.

function Get_Last
         (  Container : Table;
            Index
     : Key_Index
         )  return Row_Ptr;

This function returns a pointer to the row with the greatest key of the type Index. The result is No_Row if the table is empty.

function Get_Root_Address (Container : Table) return Byte_Index;

The result of this function is the byte index of the root bucket of the table.

function Inf
         (  Container : Table;
            Index
     : Key_Index;
            Key       : Byte_Index
         )  return Row_Ptr;

This function returns a pointer to the row with the key less than or equal the key identified by its type (Index) and value (Key). The result is No_Row if there is no such row.

procedure Initialize (Container : in out Table);

This procedure, when overridden in the child type must be called from the new implementation. Note that Set_Root_Address must be called after initialization if the table is persistent in the storage.

function Is_Empty (Container : Table) return Boolean;

This function returns true if the table is empty.

function Is_In
         (  Container : Table;
            Index
     : Key_Index;
            Key       : Byte_Index
         )  return Boolean;

This function returns true if the table contains a row identified by its type (Index) and value (Key).

procedure Remove
          (  Container : in out Table;
             Index     : Key_Index;
             Key       : Byte_Index
          );
procedure
Remove
          (  Container : in out Table;
             Index     : Key_Index;
             Key       : Byte_Index;
             Values    : out Values_Tuple
          );
procedure
Remove
          (  Container : in out Table;
             Index     : Key_Index;
             Key       : Byte_Index;
             Keys      : out Keys_Tuple;
             Values    : out Values_Tuple
          );

These procedures remove a row identified by its type (Index) and value (Key). Nothing happens if the row is not in the table. When the output parameters Keys and Value are specified they are filled with removed row's keys and values. If no row was removed they are filled with zeros.

procedure Replace
          (  Container : in out Table;
             Keys      : Keys_Tuple;
             Values    : Values_Tuple
          );
procedure
Replace
          (  Container : in out B_Tree;
             Keys      : Keys_Tuple;
             Values    : Values_Tuple;
             Replaced  : out Values_Tuple
          );

These procedures adds a new or replace an existing row indicated by Keys. When the parameter Replaced is specified it is filled with the replaced values. If the row was added Replaced is filled with zeros.

procedure Replace
          (  Container : in out Table;
             Index     : Key_Index;
             Key       : Byte_Index;
             Column    : Value_Index;
             Value     : Byte_Index
          );
procedure Replace
          (  Container : in out Table;
             Index     : Key_Index;
             Key       : Byte_Index;
             Column    : Value_Index;
             Value     : Byte_Index;
             Replaced  : out Byte_Index
          );

These procedures replace a single row value specified by the parameter Column. The row is identified by its type (Index) and value (Key). When the parameter Replaced is specified it is set to the replaced value. Contstraint_Error is propagated when there is no such row.

procedure Restore
          (  Container : in out Table;
             Reference : Byte_Index
          );

This procedure restores tree previously stored using Store. Reference is the value returned by Store. Status_Error is propagated when the tree is not empty.

procedure Set_Root_Address
          (  Container : in out Table;
             Root      : Byte_Index
          );

This procedure sets the byte index of the tree root. Status_Error is propagated when table is not empty.

procedure Store
          (  Container : in out Table;
             Reference : out Byte_Index
          );

This procedure stores the tree. Unless called the tree is removed upon finalization. After Store completion the tree is empty. It can be restored by calling to Restore and passing the returned Reference. The value must be kept between the sessions for instance in a memory pool root index (See Get_Root_Index and Set_Root_Index).

function Sup
         (  Container : Table;
            Index
     : Key_Index;
            Key       : Byte_Index
         )  return Row_Ptr;

This function returns a pointer to the row with the key greater than or equal to Key. The result is No_Row if there is no such row.

procedure Update
          (  Container : Table;
             Index
     : Key_Index;
             Key       : Byte_Index;
             Handler   : in out Update_Handler'Class
          );

This procedure changes values of the row identified by its type (Index) and value (Key) using primitive operation Update of Handler. Constraint_Error is propagated when there is no such row.

Pointers to the rows. The type Row_Ptr is used to point a key-value pair in the tree:

type Row_Ptr is private;
No_Row : constant Row_Ptr;

The value No_Row is used to indicate no row. Note that row pointers are volatile, any table update operation can potentially invalidate any pointer. The following operations are defined on the row pointer:

function Get_Bucket_Address (Row : Row_Ptr) return Byte_Index;

This function returns the address of the bucket pointed by Row. The result is 0 when Row is No_Row.

function Get_Bucket_Size (Row : Row_Ptr) return Natural;

This function returns the number of used slots in the bucket. The result is 0 when Row is No_Row.

function Get_Index (Row : Row_Ptr) return Positive;

This function returns the position in the bucket of the row pointed by Row. The result is in the range 1..Get_Bucket_Size (Row). Constraint_Error is propagated when Row is No_Row.

function Get_Key
         (  Row   : Row_Ptr;
            Index : Key_Index
         )  return Byte_Index;

This function returns the key indicated by the type Index and corresponding to Row. Constraint_Error is propagated when Row is No_Row.

function Get_Keys (Row : Row_Ptr) return Keys_Tuple;

This function returns keys corresponding to Row. Constraint_Error is propagated when Row is No_Row.

function Get_Next
         (  Row   : Row_Ptr;
            Index : Key_Index
         )  return Row_Ptr;

This function returns the pointer to the row next to one pointed by Row according to the key type Index. The result No_Row when there is no such row.

function Get_Previous
         (  Row   : Row_Ptr;
            Index : Key_Index
         )  return Row_Ptr;

This function returns the pointer to the row previous to one pointed by Row according to the key type Index. The result No_Row when there is no such row.

function Get_Root
         (  Row   : Row_Ptr;
            Index : Key_Index
         )  return Row_Ptr;

This function returns the pointer to the first row in the root bucket of the key type Index. The result No_Row when there is no such row.

function Get_Value
         (  Row    : Row_Ptr;
            Column : Value_Index
         )  return Byte_Index;

This function returns the value indicated by Row and Column. Constraint_Error is propagated when Row is No_Row.

procedure Remove (Item : in out Row_Ptr);
procedure
Remove (Item : in out Row_Ptr; Values : out Values_Tuple);

This procedure removes the row pointed by Row. Constraint_Error is propagated when Row is No_Row. After removal Row is set to No_Row. When the parameter Values is specified it accepts the values from the removed row. It is filled with zeros when no row was removed.

procedure Replace
          (  Row    : in out Row_Ptr;
             Column : Value_Index;
             Value  : Byte_Index
          );
procedure
Replace
          (  Row      : in out Row_Ptr;
             Column   : Value_Index;
             Value    : Byte_Index;
             Replaced : out Byte_Index
          );

This procedure changes the value in the row indicated by Row and Column. Constraint_Error is propagated when Row is No_Row. The parameter Replaced when specified accepts the replaced value.

procedure Replace
          (  Row    : in out Row_Ptr;
             Values : Values_Tuple
          );
procedure
Replace
          (  Row      : in out Row_Ptr;
             Value    : Values_Tuple;
             Replaced : out Values_Tuple
          );

This procedure changes values of the row indicated by Row. Constraint_Error is propagated when Row is No_Row. The parameter Replaced when specified accepts the replaced value.

procedure Update
          (  Row     : Row_Ptr;
             Handler : in out Update_Handler'Class
          );

This procedure changes values of the row indicated by Row using primitive operation Update of Handler. Constraint_Error is propagated when Row is No_Row.

User-defined update handler. The type Update_Handler is used for custom table row updates:

type Update_Handler is abstract
   new
Ada.Finalization.Limited_Controlled with null record;

The primitive operation is used to update table row:

procedure Update
          (  Handler : in out Update_Handler;
             Keys    : Keys_Tuple;
             Values  : in out Values_Tuple
          )  is abstract;

The parameter Keys is the keys of the row being modified. Values is the row values initialized by the actual row data. It can be updated to change row data.

3.3.7 Persistent waveforms

The generic child package Persistent.Memory_Pools.Streams.Generic_Float_Waveform provides a waveform allocated in an external storage. A waveform stores (x, y) pairs ordered by the x-axis. It can be tagged in order to support effective logarithmic search for various conditions like greater than a threshold over large intervals as well as getting value ranges of such intervals. It is intended for handling very large sets of data. Tagging has linear complexity.

generic
   type
X_Type is private;
   type Y_Type is digits <>;
   with function "=" (Left, Right : X_Type) return Boolean is <>;
   with function "<" (Left, Right : Y_Type) return Boolean is <>;
   with function "+" (Left : X_Type; Right : Y_Type) return X_Type is <>;
   with function "-" (Left, Right : X_Type)  return Y_Type is <>;
   with function From_X (Value : X_Type)     return Byte_Index is <>;
   with function From_Y (Value : Y_Type)     return Byte_Index is <>;
   with function To_X   (Value : Byte_Index) return X_Type is <>;
   with function To_Y   (Value : Byte_Index) return Y_Type is <>;
package Persistent.Memory_Pools.Streams.Generic_Float_Waveform is ...

The generic formal parameters are:

The implementation of the package is task-safe, the table object can be concurrently accessed from several tasks.

The package provides the following types:

type Interpolation_Mode is (None, Rightmost, Linear);

This type specifies an interpolation mode:

type Location_Type is (Empty, Less, Inside, Greater);

This type specifies the outcome location of a search operation:

type Search_Outcome (Kind_Of : Location_Type := Empty) is record
   case
Kind_Of is
      when
Empty | Less | Greater =>
         null
;
      when
Inside =>
         X1, X2 : X_Type;
         Y1, Y2 : Y_Type;
   end case
;
end record
;

This type specifies the outcome location of a search operation. If the discriminant is Inside it contains the interval found.

type Point is record
  
X : X_Type;
   Y : Y_Type;
end record
;

This type represents a waveform pair (x, y).

type Threshold_Comparison is (Above, Below);

The comparison method with a threshold:

type Range_Comparison is (Inside, Outside);

The comparison method with a range:

type Waveform
     (  Pool : access Persistent_Pool'Class
     )  is new Persistent.Memory_Pools.Streams.External_B_Tree.B_Tree
           with private
;

The waveform type. The following primitive operations are defined on Waveform:

procedure Add (Container : in out Waveform; X : X_Type; Y : Y_Type);

This procedure adds a new pair to the waveform. Constraint_Error is propagated when there is already a pair with the same x-axis value.

procedure Erase (Container : in out Waveform);

This procedure removes all pairs from the waveform.

function Find
         (  Container  : Waveform;
            X1, X2     : X_Type;
            Y          : Y_Type;
            Comparison : Threshold_Comparison;
            Mode       : Interpolation_Mode;
            Autotag    : Boolean := True
         )  return X_Type;

This function searches within the range X1..X2 for the first x-axis point where the value on the y-axis is equal or else above or under the threshold Y as specified by the parameter Comparison. The interpolation mode specifies how gaps between items in the waveform are treated. The function tags the waveform if necessary when Autotag is true otherwise Status_Error is propagated. End_Error is propagated when no value was found. Constraint_Error is propagated when the waveform is empty.

function Find
         (  Container  : Waveform;
            X1, X2     : X_Type;
            Y1, Y2     : Y_Type;
            Comparison : Range_Comparison;
            Mode       : Interpolation_Mode;
            Autotag    : Boolean := True
         )  return X_Type;

This function searches within the range X1..X2 for the first x-axis point where the value on the y-axis is inside or outside the range Y1..Y2 as specified by the parameter Comparison. The interpolation mode specifies how gaps between items in the waveform are treated. The function tags the waveform if necessary when Autotag is true otherwise Status_Error is propagated. End_Error is propagated when no value was found. Constraint_Error is propagated when the waveform is empty.

generic
   with function
Condition (Y1, Y2 : Y_Type) return Boolean is <>;
function Generic_Find
         (  Container : Waveform;
            X1, X2    : X_Type;
            Autotag   : Boolean := True
         )  return Search_Outcome;

This generic function searches within the range X1..X2 for the first x-axis point where the function Condition is true. Autotag is true otherwise Status_Error is propagated. The result is:

function Find
         (  Container : Waveform;
            Iterator  : access Abstract_Visitor'Class;
            X1, X2    : X_Type;
            Autotag   : Boolean := True
         )  return Search_Outcome;

This procedure is a non-generic variant of Generic_Find. It uses an instance of a type derived from Abstract_Visitor which implements visitor function as a primitive operation:

type Abstract_Visitor is abstract
   new
Ada.Finalization.Limited_Controlled with null record;
function Condition
         (  Iterator  : access Abstract_Visitor;
            Container : Waveform'Class;
            Y1, Y2    : Y_Type
         )  return Boolean is abstract;

The primitive abstract operation Condition returns true if the interval may contain points matching the search condition:

function Get
         (  Container : Waveform;
            X         : X_Type;
            Mode      : Interpolation_Mode
         )  return X_Type;

This function gets y-axis value corresponding to X. The interpolation mode specifies how gaps between items in the waveform are treated. End_Error is propagated when no value was found. Constraint_Error is propagated when the waveform is empty.

function Get
         (  Container : Waveform;
            X         : X_Type
         )  return Search_Outcome;

This function gets the least interval containing X. The result is:

procedure Get_Convex
          (  Container : Waveform;
             X1, X2    : X_Type;
             Mode      : Interpolation_Mode;
             Y1, Y2    : out Y_Type;
             Autotag   : Boolean := True
          );

This function gets the minimum and maximum on the interval X1..X2. The interpolation mode specifies how gaps between items in the waveform are treated, e.g. at the interval ends that may have no corresponding pair in the waveform. The interval must contain at least one pair. The function tags the waveform if necessary when Autotag is true otherwise Status_Error is propagated. End_Error is propagated when no value was found on the interval. Constraint_Error is propagated when the waveform is empty.

function Get_First_X (Container : Waveform) return X_Type;

This function returns the x-axis value of the first pair in Container. Constraint_Error is propagated when Container is empty.

function Get_First_Y (Container : Waveform) return Y_Type;

This function returns the y-axis value of the first pair in Container. Constraint_Error is propagated when Container is empty.

function Get_Next
         (  Container : Waveform;
            X         : X_Type
         )  return Point;

This function returns the pair with x-axis greater than X. End_Error is propagated when there is no such pair.

function Get_Last_X (Container : Waveform) return X_Type;

This function returns the x-axis value of the last pair in Container. Constraint_Error is propagated when Container is empty.

function Get_Last_Y (Container : Waveform) return Y_Type;

This function returns the y-axis value of the last pair in Container. Constraint_Error is propagated when Container is empty.

function Get_Point (Item : Item_Ptr) return Point;

This function returns the pair (x,y) corresponding to the B-tree item. Constraint_Error is propagated when Item is not valid.

function Get_Previous
         (  Container : Waveform;
            X         : X_Type
         )  return Point;

This function returns the pair with x-axis less than X. End_Error is propagated when there is no such pair.

function Get_X (Item : Item_Ptr) return X_Type;

This function returns the x-axis value of the B-tree item. Constraint_Error is propagated when item is invalid. It is same as Get_Point (Item).X.

function Get_Y (Item : Item_Ptr) return Y_Type;

This function returns the y-axis value of the B-tree item. Constraint_Error is propagated when item is invalid. It is same as Get_Point (Item).Y.

function Inf
         (  Container : Waveform;
            X         : X_Type
         )  return Point;

This function returns the pair with x-axis equal to or less than X. End_Error is propagated when there is no such pair.

function Inf
         (  Container : Waveform;
            X         : X_Type
         )  return Item_Ptr;

This function returns the B-tree item corresponding to the pair with x-axis equal to or less than X. It is No_Item when there is no such item.

function Is_Empty (Container : Waveform) return Boolean;

This function returns true is Container is empty.

function Is_Tagged (Container : Waveform) return Boolean;

This function returns true is Container is tagged. When tagged search functions like Find can be evaluated with logarithmic complexity. All updates of the waveform remove tagged state.

procedure Remove
          (  Container : Waveform;
             X1, X2    : X_Type
          );

This procedure removes all pairs with the x-axis values on the interval X1..X2.

procedure Replace
          (  Container : Waveform;
             X         : X_Type;
             Y         : Y_Type
          );

This procedure is similar to Add, but when there is a pair with the same x-axis, it is replaced.

procedure Restore
          (  Container : in out Waveform;
             Reference : Byte_Index
          );

This procedure restores waveform previously stored using Store. Reference is the value returned by Store. Status_Error is propagated when the waveform is not empty.

procedure Store
          (  Container : in out Waveform;
             Reference : out Byte_Index
          );

This procedure stores the waveform. Unless called the tree is removed upon finalization. After Store completion the tree is empty. It can be restored by calling to Restore and passing the returned Reference. The value must be kept between the sessions for instance in a memory pool root index (See Get_Root_Index and Set_Root_Index).

function Sup
         (  Container : Waveform;
            X         : X_Type
         )  return Point;

This function returns the pair with x-axis equal to or greater than X. End_Error is propagated when there is no such pair.

function Sup
         (  Container : Waveform;
            X         : X_Type
         )  return Item_Ptr;

This function returns the B-tree item corresponding to pair with x-axis equal to or greater than X. It is No_Item when there is no such item.

procedure Tag
          (  Container : Waveform;
           [ Progress  : in out Tagging_Progress'Class ]
          );

This procedure tags buckets of Container if necessary. Functions requiring tagging call it when necessary. Normally a waveform is filled up with pairs and then tagged before search functions are used. Tagging has O(n) complexity. The optional parameter Progress when specified is used to indicate progress.

function Interpolate
         (  X, X1, X2 : X_Type;
               Y1, Y2 : Y_Type
         )  return Y_Type;

This function implements linear two-point interpolation and extrapolation. The points are specified by pairs (X1, Y1), (X2, Y2).

The package Long_Float_Waveform is an instance Persistent.Memory_Pools.Streams.Generic_Float_Waveform with Long_Float for both x- and y-axis.


[Back][TOC][Next]

4. Unbounded arrays

The package Generic_Unbounded_Array defines the type Unbounded_Array. An instance of the type is a dynamically expanded vector of elements. The implementation keeps vector contiguous, so it might be very inefficient to put complex data structures into the array. In many cases it is better to put pointers to elements there. See also the package Generic_Unbounded_Ptr_Array which instantiates Generic_Unbounded_Array for this purpose. The type wraps the component Vector which is a pointer to an array of elements. One can use Vector to access array elements and query its present bounds, which are rather arbitrary. The unused  elements of the array vector are padded using a distinguished null-element value The package Generic_Unbounded_Array is generic and has the following generic parameters:

generic
   type Index_Type is (<>);
   type Object_Type is private;
   type Object_Array_Type is
      array (Index_Type range <>) of Object_Type;
   Null_Element : Object_Type;
   Minimal_Size : Positive := 64;
   Increment    : Natural  := 50;
package Generic_Unbounded_Array is ...

Here:

The type Unbounded_Array is declared as follows:

type Object_Array_Ptr is access Object_Array_Type;
type
Unbounded_Array is
   new Ada.Finalization.Limited_Controlled with
record
   Vector : Object_Array_Ptr := null;
end record
;

Array elements can be accessed through indexing the component Vector. Note that single what can be said about the length of the vector is that it is big enough to keep all elements put into the array. The unused elements in the vector are padded using the value Null_Element. The implementation is very straightforward. It does not implement any optimization of assignments, like the implementation of Generic_Set does. This choice was intentionally made to mimic arrays as close as possible. If reference counting is needed a wrapper type could be built around Unbounded_Array. The following operations are defined on Unbounded_Array:

procedure Erase (Container : in out Unbounded_Array);

This procedure removes all elements from Container making it empty.

procedure Finalize (Container : in out Unbounded_Array);

The destructor frees the memory allocated for the array vector.

function Fetch
         (  Container : Unbounded_Array;
            Index     : Index_Type
         )  return Object_Type;

This function returns a container element or Null_Element if Index is out of vector range.

function Get
         (  Container : Unbounded_Array;
            Index     : Index_Type
         )  return Object_Type;

This function is an equivalent to Container.Vector (Index). Constraint_Error is propagated if Index is out of vector range.

procedure Put
          (  Container : in out Unbounded_Array;
             Index     : Index_Type;
             Element   : Object_Type
          );
This procedure is used to put / replace an element in array using its index. The array vector is expanded as necessary. Unused elements are padded with Null_Element.

[Back][TOC][Next]

5. Unbounded arrays of pointers

The package Generic_Unbounded_Ptr_Array defines the type Unbounded_Ptr_Array. An instance of Unbounded_Ptr_Array is a dynamically expanded vector of pointers to elements. Upon destruction objects pointed by array elements are destroyed. Same happens when an element is replaced. The package has the following generic parameters:

generic
   type Index_Type is (<>);
   type Object_Type (<>) is limited private;
   type Object_Ptr_Type is access Object_Type;
   type Object_Ptr_Array_Type is
      array (Index_Type range <>) of Object_Ptr_Type;
   Minimal_Size : Positive := 64;
   Increment    : Natural  := 50;
package Generic_Unbounded_Ptr_Array is ...

Here:

The type Unbounded_Ptr_Array is declared through an instantiation of the package Generic_Unbounded_Array. Array elements can be accessed through indexing the component Vector which are pointers to the elements. Note that single what can be said about the length of the vector is that it is big enough to keep all elements put into the array. The unused elements in the vector are padded using null. The following operations are defined on Unbounded_Ptr_Array:

procedure Erase (Container : in out Unbounded_Ptr_Array);

This procedure removes all elements from Container making it empty.

procedure Finalize (Container : in out Unbounded_Ptr_Array);

The destructor frees the memory allocated for the array vector and all elements it refers to.

function Get
         (  Container : Unbounded_Ptr_Array;
            Index     : Index_Type
         )  return Object_Ptr_Type;

This function is an equivalent to Container.Vector (Index) with the exception that null is returned when Index is out of vector range.

procedure Put
          (  Container : in out Unbounded_Ptr_Array;
             Index     : Index_Type;
             Element   : Object_Ptr_Type
          );

This procedure is used to put in / replace an array element using its index. If the replaced array element is not null then the object it points to is destroyed. Note that the object pointed by Element is not copied. Thus it is not a responsibility of the caller to destroy the object. It will be automatically destroyed upon array destruction or replacing the element in the array. The array vector is expanded as necessary. Unused elements are padded with null.

The implementation of Generic_Segmented_Stack provides an illustration of use Generic_Unbounded_Ptr_Array. A segmented stack consists of segments of same size. The list of segments is viewed as an abstract array used to instantiate Generic_Stack. The array index is split into the high-order index indicating a segment and the low-order one specifying the element in the segment. The list of segments is implemented as an Unbounded_Ptr_Array indexed by the high-order index. Observe that once allocated a segment gets referenced in Unbounded_Ptr_Array, so there is no need to explicitly deallocate segments, Unbounded_Ptr_Array willl do it. So the implementation of Generic_Segmented_Stack can be as straightforward as:


[Back][TOC][Next]

6. Stacks

Stack, also LIFO Stack (Last in First Out), is a container in which the only accessible element is the last one.

[Back][TOC][Next]

6.1. Stacks based on abstract arrays

The package Generic_Stack defines the type Stack which provides a generic stack. The stack is built upon an array type which might be a Unbounded_Array, Unbounded_Ptr_Array, array of handles or some other type (like Unbounded_String). The package has the following generic parameters:

generic
   type Index_Type is (<>);
   type Object_Type (<>) is limited private;
   type Array_Type is limited private;
   Null_Element : Object_Type;
   with function Get
                 (  Container : Array_Type;
                    Index     : Index_Type
                 )  return Object_Type is <>;
   with procedure Put
                  (  Container : in out Array_Type;
                     Index     : Index_Type;
                     Element   : Object_Type
                  )  is <>;
package Generic_Stack is
   type Stack is new Ada.Finalization.Limited_Controlled with private;

Here the formal parameters are:

The following operations are defined on Stack:

procedure Erase (Container : in out Stack);

This procedure pops all items from the stack Container.

function Get (Container : Stack; Index : Index_Type)
   return Object_Type;

This function returns the stack item with the index specified by the parameter Index. The item item on the stack top has the index returned by Mark, so that

Top (Container) = Get (Container, Mark (Container))

Constraint_Error is propagated if Index points out of stack.

function Is_Empty (Container : Stack) return Boolean;

This function returns true if Container is empty.

function Mark (Container : Stack) return Index_Type;

The value returned by this function can be used in the procedure Release to pop all the items pushed in between. When the type Index_Type is an integer type, then the difference between two values returned by Mark is the number of stack items.

procedure Pop (Container : in out Stack; Count : Natural := 1);

This procedure pops Count items from the top of Container. If the stack does not contain enough items, it is emptied.

procedure Push (Container : in out Stack; Item : Object_Type);

This procedure pushes Item onto Container.

procedure Put
          (  Container : in out Stack;
             Index     : Index_Type;
             Element   : Object_Type
          );

This procedure replaces the stack item specified by the parameter Index with Element. The index is same as described in Get. Constraint_Error is propagated if Index points out of stack.

procedure Release (Container : in out Stack; Mark : Index_Type);

This procedure is used to pop all items pushed since a call to the function Mark which result was the value of the parameter Mark. Nothing happens if the stack was already popped below Mark.

function Top (Container : Stack) return Object_Type;

This function returns the topmost stack item. Constraint_Error is propagated if Container is empty.

[Back][TOC][Next]

6.2. Segmented stacks

The package Generic_Segmented_Stack instantiates Generic_Stack so that the stack will use a list of segments of same size. The number of stack segments is unlimited. New segments are allocated as necessary. The package is generic:

generic
   type Index_Type is (<>);
   type Object_Type is private;
   Null_Element : Object_Type;
   Segment_Size : Positive := 128;
   Minimal_Size : Positive := 64;
   Increment    : Natural  := 50;
package Generic_Segmented_Stack is
   ...
   package
Segmented_Stack is new Generic_Stack ...

Here the formal parameters are:

The package can be used as follows:

package Float_Stack is
   new Generic_Segmented_Stack (Integer, Float, 0.0);
use Float_Stack.Segmented_Stack;
...
LIFO : Stack;


[Back][TOC][Next]

7. Pools

User-defined storage pools can be used for objects which creation / destruction policy allows a more efficient memory management strategy than the standard heap offers, but yet not enough strict to allocate them on the system stack.

[Back][TOC][Next]

7.1. Stack pool

The package Stack_Storage provides an implementation of a user-defined pool organized as a stack. The package the type Pool derived form System.Storage_Pools.Root_Storage_Pool:

type Pool
     (  Initial_Size : Storage_Count;
        Items_Number : Positive
     )  is new Root_Storage_Pool with private;

A stack pool consists of contiguous segments allocated dynamically as necessary. The discriminants control the stack segments allocation policy. Initial_Size determines the initial default size of a newly allocated segment. If this size is less than the size of the object being allocated the default size is set to the object size multiplied to Items_Number. This value will then used as the default size for all further segments. The segments allocated earlier having lesser size will be freed when possible. Otherwise, they remain allocated until pool destruction. Upon stack pool destruction, all the stack segments are deallocated. No checks made whether some objects remain allocated on the stack. Note also that no checks made whether objects allocation / deallocation order is indeed LIFO (last in, first out). Deallocation of an object frees the memory of all objects allocated after it. The stack pool is not task-safe. If that is required it has to be protected from a concurrent access.

procedure Deallocate_All (Stack : in out Pool);

This procedure deallocates everything allocated in the pool. It should be used with great care.

function Get_Last_Segment (Stack : Pool) return Natural;

This function returns the number of the last segment in Stack holding some allocated data.

function Get_Segments_Number (Stack : Pool) return Natural;

This function returns the total number of segments in Stack.

procedure Get_Segment_Data
          (  Stack : Pool;
             Index : Positive;
             Size  : out Storage_Count;
             Used  : out Storage_Count;
             Start : out Address
          );

This function returns information about a segment in Stack specified by Index in the range 1..Get_Segments_Number. Size is the segment size. Used is the space allocated in the segment. Start is the first memory address of the segment. The first free address is Start + Used. Free space in the segment is Size - Used. Free space of the segments before Get_Last_Segment is not used until deallocation of memory in next segments. Constraint_Error is propagated when Index is illegal.

[Back][TOC][Next]

7.2. Mark and release pool for controlled objects

The generic child package Stack_Storage.Mark_And_Release provides an implementation of a mark and release pool for limited controlled objects:

generic
  
Stack : in out Pool'Class;
package
Stack_Storage.Mark_And_Release is ...

The generic parameter Stack is a descendant of Pool, a stack pool. The package defines:

type Pool_Object is
   new
Ada.Finalization.Limited_Controlled with private;

This is the base type for all objects to be allocated on Stack. The pool objects should be allocated only in the pool (using an allocator new). If they are destroyed explicitly using Unchecked_Deallocation, then it should happen LIFO and never under the last pool mark. The type Pool_Object has the following operations:

procedure Finalize (Object : in out Pool_Object);

The destructor has to be called by all descendants of Pool_Object. Storage_Error is propagated if Object is not the last allocated object in the pool.

procedure Initialize (Object : in out Pool_Object);
The constructor has to be called by all descendants.

type Pool_Object_Ptr is access Pool_Object'Class;
for
Pool_Object_Ptr'Storage_Pool use Stack;

This is the access type, which can be used as the target for an allocator of a Pool_Object descendant. If other access type used as the target, then it has to be specific to the pool Stack.

type Pool_Mark is
   new Ada.Finalization.Limited_Controlled with private;

Objects of Pool_Mark are used as snap-shots of the pool state. When such a pool mark object is created it remembers the pool state. Upon its destruction it finalizes all the objects allocated in the pool since its construction and reclaims the storage occupied by the objects. If some pool objects have to be destroyed explicitly, then that shall be ones created after the last pool mark creation only. The following operations are defined on Pool_Mark:

procedure Finalize (Snap : in out Pool_Mark);

The destructor removes all objects remaining in the pool since construction of Snap. Storage_Error is propagated on object finalization errors.

procedure Initialize (Snap : in out Pool_Mark);

The constructor remembers the pool state.

The following short code sample illustrates use of mark and release pool:

declare
   Snap : Pool_Mark;  -- Mark the pool state
   Ptr  : Pool_Object_Ptr;
begin

   ...
   Ptr := new Derived_Pool_Object;         -- Allocate
   ...
   Ptr := new Another_Derived_Pool_Object; -- Allocate
   ...
end;                  -- Release all allocated objects

[Back][TOC][Next]

7.3. Persistent storage memory pool

The child package Persistent.Memory_Pools provides a persistent storage memory pool. The pool implementation sits upon the direct access file provided by the package Persistent.Blocking_Files. The file keeps the memory blocks from the pool. It can be closed and reopened again. The file format and the structure of the memory pool is portable so long the underlying direct I/O access is. That means precisely that the file can be accessed on different platforms if its blocks can be read and written there.

The following data types are defined in the package:

type Root_Index is range 1..16;
subtype Byte_Count is Block_Offset range 0..Block_Offset'Last - 3;

This is the index of 16 user-defined byte indices. The indices can be read (Get_Root_Index) and written (Set_Root_Index). Typically the root memory block index is stored as an index.

type Persistent_Pool
     (  File : access Persistent_Array'Class
     )  is new Ada.Finalization.Limited_Controlled with private;

A instance of this type represents a persistent memory pool. The file object indicated by the discriminant File must be open before the pool object is created and remain open until object finalization.

Note that the implementation of Persistent_Pool is task-safe. The type operations can be used from concurrent tasks.

 The following operations are defined on the type:

function Allocate
         (  Pool : Persistent_Pool;
            Size : Byte_Count
         )  return Byte_Index;

This function allocates a memory block of at least Size byte large in the persistent pool. The result is the byte index of the first byte of the allocated memory block. The memory block is freed using Deallocate. Use_Error is propagated when no memory pool file is open, or when the file was opened read-only. See also Fetch for an eager allocator.

Allocate and Fetch cannot allocate more memory than fits into one file block. Larger objects can be allocated and used through the stream interfaces provided in the package Persistent.Memory_Pools.Streams.

procedure Commit (Pool : in out Persistent_Pool);

This procedure commits the pending transaction on the underlying file and opens a new one. The operation is task-safe. It does nothing if the file does not support transactions. Note that there is no corresponding rollback operation because rolling back the file would corrupt the pool's state. In order to return the pool to its previous state the current pool object must be finalized, the file rolled back, and a new pool object created.

procedure Deallocate
          (  Pool  : in out Persistent_Pool;
             Index : Byte_Index
          );

This procedure frees the memory block of which byte index is Index. Use_Error is propagated when no memory pool file is open, or when the file was opened read-only.

function Expand
         (  Pool  : Persistent_Pool;
            Index : Byte_Index
         )  return Byte_Count;

This function expands the memory block pointed by Index if there is a free space behind it. The result is the new block size. Use_Error is propagated when no memory pool file is open, or when the file was opened read-only.

function Fetch
         (  Pool : Persistent_Pool;
            Size : Byte_Count
         )  return Byte_Index;

This procedure allocates at least Size bytes in Pool. It tries to allocate as much space as possible. When a fitting block is found it is allocated full. The actual size of the allocated block can be obtained using Get_Size. The result is the byte index of the first byte of the allocated memory block. The memory block is freed using Deallocate. Use_Error is propagated when no memory pool file is open, or when the file was opened read-only. See also Allocate for a conservative allocator.

procedure Finalize (Pool: in out Persistent_Pool);

This procedure is called upon object destruction. When the type is derived from and this procedures is overridden, the new implementation must call it from inside.

procedure Flush (Pool: in out Persistent_Pool);

This procedure writes all cached updated file blocks back to the file. I/O errors are propagated on system errors.

function Get_Block_Size
         (  Pool  : Persistent_Pool;
            Index : Byte_Index
         )  return Byte_Count;

This function returns the total size of the block containing the byte specified by Index. Use_Error is propagated when no memory pool file is open. See also Get_Size.

function Get_Blocks_Free (Pool : Persistent_Pool) return Block_Count;

This function returns the number unused file blocks. New file blocks are allocated in the file as necessary. It is 0 when no file is open.

function Get_Blocks_Used (Pool : Persistent_Pool) return Block_Count;

This function returns the number used file blocks. It is 0 when no file is open.

function Get_Bytes_Free (Pool : Persistent_Pool) return Byte_Index;

This function returns the number unused bytes in the pool. The count does not include the memory used to maintain the internal structures of the pool. The result is 0 when no file is open.

function Get_Bytes_Used (Pool : Persistent_Pool) return Byte_Index;

This function returns the number used bytes from the pool. This does not include the memory used to maintain the pool. The result is 0 when no file is open.

function Get_Name (Pool : Persistent_Pool) return String;

This function returns the name of the file used by the pool. Use_Error is propagated when no memory pool file is open.

function Get_Root_Index
         (  Pool  : Persistent_Pool;
            Index : Root_Index
         )  return Byte_Count;

This function returns the root index corresponding to Index. Root indices are used to keep user information, e.g. the index of the master block allocated in the pool. All root indices are initialized 0. When the master blocks gets allocated or relocated Set_Root_Index can be used to set an index to point to it.

function Get_Size
         (  Pool  : Persistent_Pool;
            Index : Byte_Index
         )  return Byte_Count;

This function returns the number of bytes available to use in the block containing the byte specified by Index. Use_Error is propagated when no memory pool file is open.

function Get_Space (Pool : Persistent_Pool) return Byte_Index;

This function returns the number of bytes available for allocation in the file. The result is equal to the number of file blocks multiplied by the block size minus the length of the file header it is also equal to the sum number of free and used bytes plus the number of free and used file blocks multiplied by 4 bytes of the block margin length. Use_Error is propagated when no memory pool file is open.

procedure Initialize (Pool : in out Persistent_Pool);

This procedure must be called when overridden by derived type. The file indicated in the discriminant must be open.

function Is_Open (Pool : Persistent_Pool) return Boolean;

This function returns true if the pool file is open.

procedure Set_Root_Index
          (  Pool  : in out Persistent_Pool;
             Index : Root_Index;
             Value : Byte_Index
          );

This procedure sets the root index corresponding to Index. Root indices are persistent. They can be read back using Get_Root_Index.

procedure Truncate
          (  Pool  : in out Persistent_Pool;
             Index : Byte_Index;
             Size  : Byte_Count
          );

This procedure truncates the memory block pointed by Index to Size. Nothing happens if the new size is greater than the current one or when the freed space is less than minimal possible size. Use_Error is propagated when no memory pool file is open, or when the file was opened read-only.

7.3.1. Concurrent access to the container file

The type Holder declared in the package Persistent.Memory_Pools allows to access the underlying container file in a task-safe way.

type Holder (Pool : access Persistent_Pool'Class) is
   new
Ada.Finalization.Limited_Controlled with private;

In the scope of the object an access to the file Pool.File is exclusive.

[Back][TOC][Next]

7.4. Streams to persistent storage memory pool

The child package Persistent.Memory_Pools.Streams provides stream interfaces to the persistent storage memory pool. The interface can be used to allocate objects larger than the file block length. The contents is split into a set of linked memory blocks. The stream interface transparently crosses block borders when data are read (Input_Stream) or written (Output_Stream). Blocks are allocated transparently when the stream is written. The memory allocation strategy of output stream is eager. When an output stream is closed the unused allocated space is reclaimed. The memory allocated by writing can also be freed using Deallocate. This is the only operation that should be used on the memory allocated trough output stream. Operations like Allocate, Expand, Fetch, Truncate may not be mixed with stream operations.

7.4.1. Output streams

type Output_Stream
     (  Pool : access Persistent_Pool'Class
     )  is new Root_Stream_Type with private;

This stream object is used to store objects into the pool specified as the object's discriminant Pool. The output stream allocates memory blocks as necessary. The object can be read back from an Input_Stream. When a new stream object is written it automatically allocates the first memory block. The index of the first block can be obtained using Get_First. The storage written using streams shall not be modified otherwise than using streams defined in this package. The memory allocated by writing Output_Stream can be reclaimed using Deallocate with the index returned by Get_First. Reading from Output_Stream causes propagation of Use_Error.

procedure Append
          (  Stream : in out Output_Stream;
             Index  : Byte_Index
          );

This procedure opens previously written storage allocated at Index. Newly written data are appended to the end of used storage. Use_Error is propagated when no pool file is open. See also Open.

procedure Close (Stream : in out Output_Stream);

This procedure disconnects the stream from memory and brings it into the state of a newly created object. When closed unused memory allocated for the stream is freed. The stream contents can be read back using Input_Stream.

function Get_First (Stream : Output_Stream) return Byte_Index;

This function returns the index of the first byte allocated. It can be used in Deallocate and in operations like Append and Open. Use_Error is propagated when no stream is open or written.

function Get_Written (Stream : Output_Stream)
   return
Stream_Element_Count;

This function returns the number of stream elements written into Stream. For a newly created object the result is 0.

procedure Open
          (  Stream : in out Output_Stream;
             Index  : Byte_Index
          );

This procedure opens previously written storage allocated at Index for rewriting. Newly written data will be placed from the beginning of the allocated storage. Use_Error is propagated when no pool file is open. See also Append.

procedure Read
          (  Stream : in out Output_Stream;
             Item   : out Stream_Element_Array;
             Last   : out Stream_Element_Offset
          );

This procedure propagates Use_Error.

procedure Write
          (  Stream : in out Output_Stream;
             Item   : Stream_Element_Array
          );

The implementation of stream interface stores written element into the memory blocks allocated in the pool. Use_Error is propagated when no memory pool file is open. I/O errors are propagated on other errors.

The following code sample illustrates usage of Output_Stream and Input_Stream:

declare
   Pool  : aliased Persistent_Pool;
   Hello : Byte_Index;
begin
   Open (Pool, "my_storage.dat"); -- Open external file
   declare
      Output : aliased Output_Stream (Pool'Access);
   begin
      String'Output (Output'Access, "Hello World!");
      Hello := Get_First (Output);
   end;
   -- Now "Hello World!" is stored in the pool at Hello
   -- The memory pool can be closed and the application
   -- exited. Another application can open the pool and
   -- read stored string at Hello as follows:
   ...
   declare
      Input : aliased Input_Stream (Pool'Access);
  
begin
      Open (Input, Hello); -- Set input stream to Hello
      declare
         Data : String := String'Input (Input'Access);
      begin -- Now Data is "Hello World!"
         ...
      end;
   end;
   ...

7.4.2. Input streams

type Input_Stream
     (  Pool : access Persistent_Pool'Class
     )  is new Root_Stream_Type with private;

The input stream is set to the first allocated memory block written using Output_Stream. When reading from the stream the internal pointer moves through the allocated memory up to the last stored stream element.

procedure Close (Stream : in out Input_Stream);

This procedure disconnects the stream from memory and brings it into the state of a newly created object.

function Compare
         (  Left  : Input_Stream;
            Right : Stream_Element_Array
         )  return Precedence;
function
Compare
         (  Left  : Input_Stream;
            Right : String
         )  return Precedence;

These functions compare the unread contents of stream with another stream or an array of stream elements or characters of a string. The result is of the enumeration Less, Equal, Greater defined in Strings_Edit.Lexicographical_Order. An unopened stream is considered empty.

function End_Of (Stream : Input_Stream) return Boolean;

This function returns true if the end of stream is reached. For a newly created object the result is 0.

function Equal
         (  Stream : Input_Stream;
            Item   : Stream_Element_Array
         )  return Boolean;
function
Equal
         (  Stream : Input_Stream;
            Text   : String
         )  return Boolean;

These functions compare the unread contents of Stream with an array of stream elements or characters of a string. The result is true if both are equal. An unopened stream is considered empty.

function Get_First (Stream : Input_Stream) return Byte_Index;

This function returns the index of the first byte allocated. It can be used in Deallocate and in operations like Append and Open. Use_Error is propagated when no stream is open or written.

function Get_Length (Stream : Input_Stream) return Stream_Element_Count;

This function returns the number of elements allocated. For a newly created object the result is 0.

function Get_Unread (Stream : Input_Stream) return Stream_Element_Count;

This function returns the number of elements to read. At the beginning it is equal to Get_Length, at the end it is 0. For a newly created object the result is 0.

function Less
         (  Stream : Input_Stream;
            Item   : Stream_Element_Array
         )  return Boolean;
function
Less
         (  Stream : Input_Stream;
            Text   : String
         )  return Boolean;

These functions compare the unread contents of Stream with an array of stream elements or characters of a string. The result is true if the unread content of Stream is less than the second parameter. An unopened stream is considered empty.

procedure Open
          (  Stream : in out Input_Stream;
             Index  : Byte_Index
          );

This procedure sets the stream to read from the storage at Index. It must be called before reading from the stream. Use_Error is propagated when no memory pool file is open.

procedure Read
          (  Stream : in out Input_Stream;
             Item   : out Stream_Element_Array;
             Last   : out Stream_Element_Offset
          );

The implementation of stream interface read elements from the memory blocks allocated in the pool. Use_Error is propagated when no memory pool file is open. I/O errors are propagated on other errors.

procedure Rewind (Stream : in out Input_Stream);

This procedure re-opens the stream from the beginning.

procedure Write
          (  Stream : in out Input_Stream;
             Item   : Stream_Element_Array
          );

This procedure propagates Use_Error.

7.4.3. Generic look ahead

The generic procedure Look_Ahead is used to scan the unread contents of the stream without actually reading it:

generic
   type
User_Data_Type (<>) is limited private;
   type
Visitor_Type is access procedure
       
Contents  : Byte_Array;
           User_Data : in out User_Data_Type;
           Continue  : out Boolean
        );
procedure
Look_Ahead
          (  Stream    : Input_Stream'Class;
             Visit     : Visitor_Type;
             User_Data : in out User_Data_Type
          );

The parameter Stream is the input stream. User_Data is the data to pass along to the visitor call-back. Visit is the callback called on chucks of the allocated data not yet read through the stream. The procedure's first parameter Contents is the array of stream bytes to process. The parameter User_Data is same as in the call to Look_Ahead. The parameter Continue is used to indicate premature completion. When set to true the process is continued to the next chuck of unread allocated data. When set to false Look_Ahead returns immediately. Use_Error is propagated when the stream is not open.

7.4.4. Progress indicator

The package provides abstract data type for indicating progress of potentially lengthy tagging operations:

subtype Advance is Float range 0.0..1.0;
type Tagging_Progress is abstract
   new
Object.Entity with null record;

The following primitive operations are defined:

procedure Complete
          (  State    : in out Tagging_Progress;
             Progress : Advance
          );

This procedure is called to indicate tagging progress. It may propagate an exception in order to cancel tagging. The default implementation does nothing. Typically an implementation that outputs the progress would use clock to limit its frequency.

procedure Start (State : in out Tagging_Progress);

This procedure is called before tagging starts. It may propagate an exception in order to cancel tagging. The default implementation does nothing.

procedure Stop (State : in out Tagging_Progress);

This procedure is called after tagging completes. The default implementation does nothing.


[Back][TOC][Next]

8. Doubly-linked networks

The generic package Generic_Doubly_Linked_Web provides double-linked networks of items:

generic
   type
List_Identification_Type is (<>);
   type List_Item_Type (<>) is limited private;
   Pool : in out Root_Storage_Pool'Class;
package Generic_Doubly_Linked_Web is ...

The items can be of any type as specifies the formal parameter List_Item_Type. This includes limited and unconstrained types. They are not required to be tagged. So protected objects or tasks can be items. The items are never copied when inserted into, moved along or removed from a list. All operations on the network lists and their items are referential. Insertion and removal are O(1). An item of the network may participate several lists of different types. The set of distinct list types is determined by the formal parameter List_Identification_Type, which is a discrete type. For each value of this type each item has a pair of pointers (links). So the number of values of List_Identification_Type is the number of lists an item can be simultaneously situated in. For a standard doubly-linked list where an item can be in only one list, the parameter List_Identification_Type could be, for example:

   type List_Identification is (The_List);

For multiple lists as illustrated on the figure below, it could be:

   type List_Identification is (Blue, Green, Red);

doubly-linked list

The figure shows 5 items forming a network of 4 lists of 3 different types. For instance, the item B is in the blue list A-B-C-D, green list B-C-D and red list B-C-D-E.

The items are allocated in the storage pool specified by the formal parameter Pool. The service data (links) associated with an item are allocated in Pool.

The package provides the access type Node for referencing the items and the access type Web to reference the head items of lists. Note that each list is circular, so any of its items can be considered as a head. All list operations are defined in terms of Node and Web. Naturally, Web and Node are freely convertible to each other:

type Node is access List_Item_Type;
type
Web is new Node;

A distinct type was chosen to separate pointers to items from ones to lists. This was important for aliasing prevention. For example if Node were used in Delete, then the following would be legal:

Delete (Messages, List_Head, List_Head);

So the operation Delete could finalize the item referenced by the third parameter, and thus set List_Head to null. At the same time it would set the second parameter to point to the next item in the list, setting List_Head to some not null value. The result would depend on the compiler and the program were erroneous. This manifests an aliasing problem, which cannot occur because in Delete the second parameter has the type Web, making it impossible to mistakenly alias it to another type.

The representation clause

for Node'Size use Integer_Address'Size;

is used to prevent the compiler from making "fat" pointers out of Node and Web. This should actually be Address'Size, but that would be illegal because Address'Size is not a static expression in Ada. The type Integer_Address should have same size as Address on almost all architectures. If it is not, change it to an explicit number. Remember that the size is specified in bits.

A list item is created by using the allocator new. The obtained pointer is passed to Append (Prepend) or Insert as appropriate. The procedure Append is used for creating a new list. The list is specified by a pointer to its head. So it can be created like:

   Head : Web; -- Empty list
begin
   Append (Messages, Head, new Object);

Now Head points to the newly allocated item in the list. Subsequent items can be created as:

   Append (Messages, Head, new Object);

The first parameter of all list operations is the type of the list. If there were several types of lists, we could place the same item into different lists. For example:

type Signal is
   new abstract
Ada.Finalization.Limited_Controlled with private;
type Signal_List is (Alarm, Log);
type Some_Ptr is access Any; -- The default storage pool
package Signal_Lists is
   new
Generic_Doubly_Linked_Web
       (  Signal_List,
          Signal'Class,
          Some_Ptr'Storage_Pool
       );
...
Message := new Error_Message; -- Derived from Signal
Append (Alarm, Notifications_List, Message);
Append (Log,   System_Trace_List,  Message);

Both Append or Insert are intended for placing newly allocated items or items removed from their lists before. To move an item from one list to another of the same type they take an additional parameter Source to specify the head of the list, the element is removed from. These procedures are equivalent to a call to Remove with a subsequent Append or Insert as required. The difference between  Append and Insert is that for Append the list head is specified and thus the list can be empty. For Insert the list head is not identified and the list cannot be empty. The design of these operations was chosen to prevent, when possible, dangling pointers and garbage. For this reason all operations that remove an item from a list refer to the list head. When appropriately used, the rest of the list should not become unreferenced. The deallocator of the storage pool where the list items are kept, checks freed items for being unreferenced. When a freed item is still in a list, Program_Error is propagated out of Unchecked_Deallocation.

There is no special function to obtain the first element in the list because the list head is also the first element. So:

Element := Node (Container);

would do the job.

The following list operations are defined:

procedure Append
          (  Brand     : List_Identification_Type;
             Container : in out Web;
             Element   : Node;
          );

This procedure inserts Element is at the end of Container. Element is either a newly allocated item or an item outside any lists of the type Brand. Constraint_Error is propagated when Element already is in a list. This includes Container. Container can be empty before a call to the procedure, in which case Element becomes the head of it. See also Prepend.

procedure Append
          (  Brand     : List_Identification_Type;
             Container : in out Web;
             Element   : Node;
             Source    : in out Web
          );

This procedure is an equivalent to Remove followed by Append without the parameter Source. It moves Element from Source to Container. When Source and Container is the same list Container parameter takes advantage. Constraint_Error is propagated when Element is null. See also Prepend.

procedure Delete
          (  Brand     : List_Identification_Type;
             Container : in out Web;
             Element   : in out Node
          );

This procedure removes Element from Container. The item following Element becomes the new list head. The operation is void when Element is null. The parameter Container is ignored when null. When Element after its removal does not belong to any list its target object is finalized, freed, and then Element is set to null.

procedure Erase
          (  Brand     : List_Identification_Type;
             Container : in out Web
          );

This procedure removes all elements from Container. When an element after its removal does not belong to any list its target object is finalized and freed. 

procedure Insert
          (  Brand    : List_Identification_Type;
             Position : Node;
             Element  : Node
          );

This procedure inserts Element after the item specified by the parameter Position. Element may not be in any list. Constraint_Error is propagated otherwise or when Element is null. Constraint_Error is also propagated when Position is null or not in a list of Brand type. Insert is similar to Append, with the difference that an arbitrary list item is used to indicate the insertion position. For this reason Append can deal with empty lists, while Insert requires at least one item in. To insert Element before Position use:

Insert (Brand, Previous (Brand, Position), Element); 

procedure Insert
          (  Brand    : List_Identification_Type;
             Position : Node;
             Element  : Node;
             Source   : in out Web
          );

This procedure is an equivalent to Remove followed by Insert. It moves Element from Source to the list of Position. The parameter has the same meaning as in Insert. When Position and Element refer the same item, the procedure does nothing. Constraint_Error is propagated when Element or Position is null. It is also propagated when Position is not in a list of Brand type.

function Is_Empty
         (  Brand     : List_Identification_Type;
            Container : Web
         )  return Boolean;

This function return true if Container is null. For containers of he type Web emptiness is equivalent to being null.

function Is_In
         (  Brand   : List_Identification_Type;
            Element : Node
         )  return Boolean;

This function return false if Element is null or else is not in any list of Brand type. Where Is_In returns false Next and Previous would raise Contraint_Error.

function Is_In (Element : Node) return Boolean;

This function return false if Element is null or else is not in any list of any type.

procedure Merge
          (  Brand : List_Identification_Type;
             Head  : in out Web;
             Tail  : in out Web
          );

This procedure merges two lists. The list Tail is appended to the list Head. Either of the list can be null. The operation is void if Head = Tail. After completion Head and Tail point to the merged sublists.

function Next
         (  Brand   : List_Identification_Type;
            Element : Node
         )  return Node;
function Next
         (  Brand     : List_Identification_Type;
            Container : Web
         )  return Node;

These functions return item following either Element or the head of Container. Constraint_Error is propagated in all cases when there is no next item. Note that when the element is in a list of Brand type, it always has a next element, maybe itself. The list is circular.

procedure Prepend
          (  Brand     : List_Identification_Type;
             Container : in out Web;
             Element   : Node;
          );

This procedure inserts Element is in front of Container. Element is either a newly allocated item or an item outside any lists of the type Brand. Constraint_Error is propagated when Element already is in a list. This includes Container. Container can be empty before a call to the procedure, in which case Element becomes the head of it. See also Append.

procedure Prepend
          (  Brand     : List_Identification_Type;
             Container : in out Web;
             Element   : Node;
             Source    : in out Web
          );

This procedure is an equivalent to Remove followed by Prepend without the parameter Source. It moves Element from Source to the beginning of Container. When Source and Container is the same list Container parameter takes advantage. Constraint_Error is propagated when Element is null. The operation is void when Container and Element refer to the same item See also Append.

function Previous
         (  Brand   : List_Identification_Type;
            Element : Node
         )  return Node;
function Previous
         (  Brand     : List_Identification_Type;
            Container : Web
         )  return Node;

These functions return item preceding either Element or the head of Container. Constraint_Error is propagated in all cases when there is no previous item. When the element is in a list of Brand type, it always has a next element, maybe itself, because the list is circular.

procedure Remove
          (  Brand     : List_Identification_Type;
             Container : in out Web;
             Element   : Node
          );

This procedure removes Element from Container. The item following Element becomes the new list head. The operation is void when Element is not in a list or null. The parameter Container is ignored when null. Unlikely to Delete Element is never freed.

procedure Take
          (  Brand     : List_Identification_Type;
             Container : in out Web;
             Element   : out Node
          );

This procedure removes the first element from Container. The item following it becomes the new list head. The removed element is returned through the parameter Element. It is set to null when Container is empty. When returned Element is not null and not in any list (Is_In (Element) = false), then it becomes the caller's responsibility either to destroy Element or to return it back to a list.

function Dope_Size return Storage_Offset;

This informational function returns the number of storage elements the compiler places in front of an item. The value is estimated and is available only after first call to a list operation. Constraint_Error is propagated when the size is yet not determined.

[Back][TOC][Next]

8.1. Doubly-linked lists of networks (specialization)

The generic child package Generic_Doubly_Linked_Web.Generic_List provides a specialization of Generic_Doubly_Linked_Web constrained to one type of lists:

generic
   type
Brand : List_Identification_Type;
package
Generic_Doubly_Linked_Web.Generic_List is ...

The formal parameter Brand specifies the type of the list. The package defines specialized types of list nodes and list heads corresponding to Node and Web:

type Item is new Node;
type
List is new Web;

Items of the network can be allocated using either of these access types. The purpose of Item and List is specify which type links are involved in the specialized operations:

procedure Append (Container : in out List; Element : Item);

This procedure is specialized version of Append.

procedure Append
          (  Container : in out List;
             Element   : Item;
             Source    : in out List
          );
procedure
Append
          (  Container : in out List;
             Element   : Node;
             Source    : in out List
          );

This procedure is specialized version of moving Append. The parameter Element can be of either Item or Node types.

procedure Delete (Container : in out List; Element : in out Item);
procedure
Delete (Container : in out List; Element : in out Node);

This is a specialized version of Delete. The parameter Element can be of either Item or Node types.

procedure Erase (Container : in out List);

This is specialized version of Erase. It removes all elements from Container. When an element after its removal does not belong to any list its target object is finalized and freed. 

procedure Insert (Position : Item; Element : Item);
procedure
Insert (Position : Node; Element : Item);

This is a specialized version of Insert. The parameter Position can be of either Item or Node types. The parameter Element is only of Item type, because otherwise it were impossible to resolve names overloading. Though Item and Node resemble base and derived tagged types, they are not.

procedure Insert
          (  Position : Item;
             Element  : Item;
             Source   : in out List
          );
procedure
Insert
          (  Position : Item;
             Element  : Node;
             Source   : in out List
          );
procedure
Insert
          (  Position : Node;
             Element  : Item;
             Source   : in out List
          );
procedure
Insert
          (  Position : Node;
             Element  : Node;
             Source   : in out List
          );

These procedures are specialized versions of moving Insert. The parameters Position and Element can be of any combination of Item or Node types.

function Is_In (Element : Item) return Boolean;

These function return false if Element is null or else is not in any list of the Brand type.

procedure Merge (Head : in out List; Tail : in out List);

This procedure merges two lists. It is a specialized version of Merge.

function Next(Element : Item) return Item;
function Next(Container : List) return Item;

These are specialized versions of Next.

procedure Prepend (Container : in out List; Element : Item);

This procedure is specialized version of Prepend.

procedure Prepend
          (  Container : in out List;
             Element   : Item;
             Source    : in out List
          );
procedure
Prepend
          (  Container : in out List;
             Element   : Node;
             Source    : in out List
          );

This procedure is specialized version of moving Prepend. The parameter Element can be of either Item or Node types.

function Previous (Element : Item) return Item;
function Previous (Container : List) return Item;

These are specialized versions of Previous.

procedure Remove
          (  Container : in out List;
             Element   : Item
          );
procedure
Remove
          (  Container : in out List;
             Element   : Node
          );

This is specialized version of Remove. The parameter Element can be of either Item or Node types.

procedure Take
          (  Container : in out List;
             Element   : out Item
          );
procedure
Take
          (  Container : in out List;
             Element   : out Node
          );

This is a specialized version of Take. The parameter Element can be of either Item or Node types.

[Back][TOC][Next]

8.2. Doubly-linked lists

The generic package Generic_Doubly_Linked provides plain double-linked lists of elements allocated in the standard storage pool. The package is provided to simplify use of Generic_Doubly_Linked_Web for this case.

generic
   type
List_Item_Type (<>) is limited private;
package Generic_Doubly_Linked is
   ...
   package
Doubly_Linked is ...

The typical use of the package is as follows:

type My_Item is ...;
package
My_Lists is new Generic_Doubly_Linked (My_Item);
use
My_Lists.Doubly_Linked;

The package Doubly_Linked is an instance of Generic_Doubly_Linked_Web.Generic_List, which provides the types  Item and List and operations on them (see warning).

8.2.1. Doubly-linked list example

The example represents an implementation of a simple scheduler of jobs. There is a pool of worker tasks and a queue of abstract jobs. The tasks take jobs from the queue, process them and then return them back to the queue. A doubly-linked list us used as the queue implementation. Jobs are tagged, so the queue contains class-wide objects. The example is located in the test_components subdirectory.

File test_linked_lists_scheduler.ads:
with Ada.Finalization;
with Generic_Doubly_Linked;

package Test_Linked_Lists_Scheduler is
   --
   -- Job -- Abstract piece of work
   --
   type Job is
      abstract new
Ada.Finalization.Controlled with
         null record
;
   procedure Do_It (Work : in out Job) is abstract;

   package Job_List  is new Generic_Doubly_Linked (Job'Class);
   use Job_List.Doubly_Linked;

The package Test_Linked_List_Scheduler declares an abstract type Job, which is a piece of work to be done. The abstract procedure Do_It is to be overridden by a concrete job. It is called by a worker task to accomplish the job. The package Job_List instantiates Generic_Doubly_Linked with Job'Class as the parameter. The package Job_List.Doubly_Linked provides a doubly linked list of Job'Class objects. Note that the list elements are class-wide, i.e. it can contain any kind of jobs.

File test_linked_lists_scheduler.ads (continuation):
   --
   -- Worker -- A task doing jobs
   --

   task type Worker;
   --
   -- Submit -- A new job for processing
   --
   procedure Submit (Work : Item);
   --
   -- Shut_Down -- Purge the jobs queue and stop workers
   --
   procedure Shut_Down;

The type Worker is a task doing jobs. The procedure Submit is used to submit a job. It has the parameter of the type Item which is an access to Job'Class. The procedure Shut_Down is used to purge the jobs queue and stop all workers.

File test_linked_lists_scheduler.ads (continuation):
   --
   -- Print_Me -- A concrete job, prints some text
   --

   type Print_Me (Length : Natural) is new Job with record
      Text : String (1..Length);
   end record;
   procedure Do_It (Work : in out Print_Me);
   function Have_To_Print (Text : String) return Item;

end Test_Linked_Lists_Scheduler;

The type Print_Me is a concrete job. It prints a text on the screen.

File test_linked_lists_scheduler.adb:
with Ada.Text_IO;  use Ada.Text_IO;

package body Test_Linked_Lists_Scheduler is

   Queue_Closed : exception;

   protected Waiting_Queue is
      entry
 Get_For_Service (Work : out Item);
      procedure Shut_Down;
      procedure Submit (Work : Item);
   private
      Queue  : List;
      Closed : Boolean;
   end Waiting_Queue;

The protected object Waiting_Queue holds the list of jobs waiting for service. It has the entry point Get_For_Service called by a worker to get a new job to do. The exception Queue_Closed is used to notify a worker that it has to exit. The procedure Shut_Down closes the queue. The procedure Submit puts a new job into the queue.

File test_linked_lists_scheduler.adb (continuation):
   protected body Waiting_Queue is
      entry
Get_For_Service (Work : out Item)
         when Closed or else Queue /= null is
      begin
         if
Closed then
            raise
Queue_Closed;
         else
            Take (Queue, Work); -- The first in the list
         end if;
      end Get_For_Service;

      procedure Submit (Work : Item) is
      begin

         Append (Queue, Work); -- Add to the end
         if Closed then
            Erase (Queue);
         end if;
      end Submit;

      procedure Shut_Down is
      begin

         Closed := True;
         Erase (Queue);
      end Shut_Down;

   end Waiting_Queue;

The implementation of Waiting_Queue is straightforward. The procedure Get_For_Service uses Take to extract the first job from the queue. Its barrier contains Queue /= null, which is non-empty queue test. The barrier is always true after a call to Shut_Down. In this case Queue_Closed is propagated out of Get_For_Service. The procedure Submit places a new Job into the queue.

File test_linked_lists_scheduler.adb (continuation):
   task body Worker is
      This : Item;
   begin
      loop

         Waiting_Queue.Get_For_Service (This);
         -- Now we are holding This, so be careful with exceptions,
         -- the item must back to the queue in all cases
         begin
            This.Do_It;
               -- Item has been serviced, return it back
            Waiting_Queue.Submit (This);
         exception
            when
Queue_Closed =>
               exit;
            when others =>
               Waiting_Queue.Submit (This);
         end;
      end loop;
   end Worker;

The implementation of a worker task runs an infinite loop in which it takes a job from the queue using Get_For_Service and then calls Do_It for the job (note, Ada 2005 syntax). After that it submits the job back. When Queue_Closed is propagated out of Get_For_Service, the worker exits.

File test_linked_lists_scheduler.adb (continuation):
   procedure Submit (Work : Item) is
   begin

      Waiting_Queue.Submit (Work);
   end Submit;

   procedure Shut_Down is
   begin

      Waiting_Queue.Shut_Down;
   end Shut_Down;

The implementation of Submit and Shut_Down procedures call to the corresponding ones of the protected object.

File test_linked_lists_scheduler.adb (continuation):
   procedure Do_It (Work : in out Print_Me) is
   begin
  
   Put_Line (Work.Text);
   end
Do_It;

   function
Have_To_Print (Text : String) return Item is
   begin
      return
         new
Print_Me'
             (  Job
             with
                Length => Text'Length,
                Text   => Text
             );
   end Have_To_Print;

end Test_Linked_Lists_Scheduler;

The implementation of the Print_Me job. The procedure Do_It prints the text. The function Have_To_Print allocates a new job object.

File test_linked_lists_scheduler_test.adb:
with Test_Linked_Lists_Scheduler;  use Test_Linked_Lists_Scheduler;

procedure Test_Linked_Lists_Scheduler_Test is
   W1 : Worker;
   W2 : Worker;
   W3 : Worker;
   W4 : Worker;
   W5 : Worker;
begin
   Submit (Have_To_Print ("The"));
   Submit (Have_To_Print ("quick"));
   Submit (Have_To_Print ("brown"));
   Submit (Have_To_Print ("fox"));
   Submit (Have_To_Print ("jumps"));
   Submit (Have_To_Print ("over"));
   Submit (Have_To_Print ("the"));
   Submit (Have_To_Print ("lazy"));
   Submit (Have_To_Print ("dog"));
   delay 10.0;
   Shut_Down;
end Test_Linked_Lists_Scheduler_Test;

The test program creates five worker tasks and submits 9 jobs. After 10 seconds of processing it terminates.


[Back][TOC][Next]

9. Graphs

Directed graph is a binary relation G:E×E→[0,1] defined on a set of nodes E (also called vertices). Two nodes a and b are said connected by an edge (also by an arrow or arc) leading from a to b in the graph G when aGb. Here the node a is called parent, the node b is called child. A directed graph is acyclic when the transitive closure G* of the graph G is irreflexive (i.e. aG*a does not hold for any node a). The transitive closure of a graph is an infinite union of compositions of the relation G:

G* = G ∪ G∘G ∪ G∘G∘G ∪...

where composition and union of relations are defined as:

a,b   aR∘Sb = ∃c aRccSb    aR∪Sb = aRbaSb

The meaning of the transitive closure G* is that aG*b holds when there is a path of any length from a to b in G. In a directed acyclic graph no path leads back to any node. The tree is a case of the directed acyclic graph when additionally for any node there is no more than one parent. Thus any types of trees can be represented by a directed graph. The undirected graph is a directed graph when G is symmetric (commutative).

directed graph

A weighted graph has a weight associated with each edge. The binary relation G is generalized to a function mapping nodes to the weights G:E×E→W. The union of weighted graphs can be then defined using some operation +:W×W→W on the weights:

a,b aR∪Sb = aRb+aSb

The composition of weighted graphs is defined using + and a second operation *:W×W→W:

a,b aR∘Sb = Π
c∈E
aRc+cSb

The transitive closure G* in these terms may exist or not depending on the chosen operations + and *.

directed weighted graph

The above represents an example of a directed weighted graph used in syntax analysis (state automate describing a numeric literal). The nodes are states, the weights are sets of chains of characters (patterns). The operation + is concatenation, the operation * is alternation.

[Back][TOC][Next]

9.1. Directed graphs

The package Generic_Directed_Graph provides a generic implementation of directed graphs:

generic
   type
Node_Type (<>) is limited private;
  
Pool                  : in out Root_Storage_Pool'Class;
   Minimal_Parents_Size  : Positive := 16;
   Minimal_Children_Size : Positive := 16;
   Increment             : Natural  := 50;
   with function Equal (Left, Right : access Node_Type) return Boolean is <>;
   with function Less  (Left, Right : access Node_Type) return Boolean is <>;
package
Generic_Directed_Graph is ...

The formal parameters are:

The formal operations Equal and Less are required for the sets of children or parents of a given node, which has to be sorted. They are also used for enumeration of the children and parents. The node position in the operations like Get_Child is determined by this order. An implementation of Equal and Less can be based on the contents of the nodes. In other cases, when the order of nodes in is of no importance, the helper package Generic_Address_Order can be used to produce the operations Equal and Less for Node_Type. In this case the nodes will be ordered according to their memory addresses.

The graph nodes are referenced using the access type Node defined in the package:

type Node is access Node_Type;

The type is a pool specific access type bound to the storage pool defined in the package. The pool is a proxy pool, which ultimately takes storage from the pool specified by the formal parameter Pool. The proxy storage pool maintains the sets of parent and children nodes transparently to the node object. Thus there is no need to derive graph nodes from a dedicated parent type or interface related specifically to the graph implementation.

The package defines the types:

type Subgraph_Type is mod 2**3;

The values of the type Subgraph_Type characterize a node relatively to the given one The constants are defined:

The array of nodes:

type Nodes_Array is array (Positive range <>) of Node;

The following operations are defined on Node:

procedure Connect
          (  Parent  : Node;
             Child   : Node;
             Acyclic : Boolean := True
          );

This procedure creates a directed edge from Parent to Child. When the edge already exists this operation is void. In the case when Parent has a child different from Child, yet equivalent to it according to the provided comparison operation, or else Child has a parent equivalent, but different from Parent, then Argument_Error is propagated. Additionally when Acyclic is true, it is checked that the new edge would not create a cycle in the graph, that is when Child would become or already is an ancestor of Parent. Otherwise Constraint_Error is propagated. Note that checking potentially requires traversal of all nodes of the graph. Constraint_Error is also propagated when either Parent or Child is null.

procedure Delete
          (  Vertex   : in out Node;
             Subgraph : Subgraph_Type := Any
          );

This procedure deletes a subgraph connected to Vertex. The parameter Subgraph specifies which parts of the graph to be removed and freed: For example in order to delete Vertex and all its descendants Subgraph should be Descendant or Self. When the object referenced by Vertex is destroyed, Vertex is set to null. The operation is void when Vertex is null. Delete does not create new edges, therefore a connected graph can become disjoint. See Remove, which keeps graph connected.

procedure Disconnect (Parent : Node; Child : Node);

This procedure removes the edge from Parent to Child if the edge exist. Otherwise the operation is void. For example, In order to move a subtree from one parent node to another one use Disconnect followed by Connect. Constraint_Error is propagated when either Parent or Child is null.

function Find_Child (Parent : Node; Child : Positive) return Natural;

This function returns the position of Child in the list of children of the node Parent. All children of a node are enumerated from 1 according to the formal functions Equal and Less. See also Get_Child. The result is 0 when Child is not a child of Parent. Constraint_Error is propagated when Parent or Child is null.

function Find_Parent (Parent : Node; Child : Positive) return Natural;

This function returns the position of Parent in the list of parents of the node Child. All parents of a node are enumerated from 1 according to the formal functions Equal and Less. See also Get_Parent. The result is 0 when Parent is not a parent of Child. Constraint_Error is propagated when Parent or Child is null.

procedure Free is new Ada.Unchecked_Deallocation (Node_Type, Node);

This procedure deletes the node object. Program_Error is propagated when the node is in a graph. This includes the cases when the node is a parent / child of itself. See the function Is_Connected.

function Get_Children (Parent : Node) return Nodes_Array;
function
Get_Children (Parent : Node) return Node_Sets.Set;

This function returns the array containing the children nodes of Parent. Constraint_Error is propagated when Parent is null.

function Get_Children_Number (Parent : Node) return Natural;

This function returns the number of children of the node Parent. Constraint_Error is propagated when Parent is null.

function Get_Child (Parent : Node; Child : Positive) return Node;

This function returns a child of the node Parent by its position Child. Constraint_Error is propagated when Child > Get_Children_Number (Parent) or else Parent is null.

function Get_Parent (Child : Node; Parent : Positive) return Node;

This function returns a parent of the node Child by its position Parent. Constraint_Error is propagated when Parent > Get_Parents_Number (Child) or else Child is null.

function Get_Parents (Child : Node) return Nodes_Array;
function
Get_Parents (Child : Node) return Node_Sets.Set;

This function returns the array or set containing the parent nodes of Child. Constraint_Error is propagated when Child is null.

function Get_Parents_Number (Child : Node) return Natural;

This function returns the number of parents of the node Child. Constraint_Error is propagated when Child is null.

function Is_Ancestor (Parent : Node; Child : Node) return Boolean;

This function evaluates the transitive closure of G. The result is true when Parent G* Child, i.e. when there is a path in G from Parent to Child. Constraint_Error is propagated when either Parent or Child is null.

function Is_Connected (Vertex : Node) return Boolean;

This function returns true when the node Vertex is connected by an edge. Constraint_Error is propagated when Vertex is null.

function Is_Descendant (Child : Node; Parent : Node) return Boolean;

This function evaluates the transitive closure of G-1. The result is true when Child G-1* Parent, i.e. when there is a path in G-1 from Child to Parent. This is equivalent to Is_Ancestor (Parent, Child), but computed differently by tracking the edges backwards from Child to Parent. Constraint_Error is propagated when either Parent or Child is null.

function Is_Sibling (Left, Right : Node) return Boolean;

This function returns true if Left and Right share at least one parent. Constraint_Error is propagated when either Left or Right is null.

function Precedes (Left, Right : Node) return Boolean;

Comparison of nodes used in node sets, induced by the formal function Less. The value null is considered preceding all valid access values.

function Related (Parent : Node; Child : Node) return Boolean;

This function evaluates G. The result is true when Parent G Child i.e. when there is an edge from Parent to Child. Constraint_Error is propagated when either Parent or Child is null.

procedure Remove (Vertex : Node);

This procedure removes Vertex from the graph. Each pair of edges leading from a parent of Vertex to a child of Vertex, is replaced by an edge from the parent to the child, thus the graph remains connected. The effect of the operation is obtaining an equivalent graph, such that aG'b = aGb for all nodes except the removed. The object pointed by Vertex is not deleted. Constraint_Error is propagated when Vertex is null.

function Same (Left, Right : Node) return Boolean;

The nodes comparison function used in node sets, induced by the formal function Equal. The value null is considered preceding all valid access values.

The package instantiates the packages Generic_Unbounded_Array and Generic_Set with the type Node:

package Node_Arrays is
   new
Generic_Unbounded_Array (Positive, Node, Nodes_Array, null);
package
Node_Sets is
   new
Generic_Set (Node, null, "=" => Same, "<" => Precedes);

[Back][TOC][Next]

9.2. Directed weighted graphs

The package Generic_Directed_Weighted_Graph provides a generic implementation of directed weighted graphs:

generic
   type
Node_Type (<>) is limited private;
   type
Weight_Type (<>) is private; 
  
Pool                  : in out Root_Storage_Pool'Class;
   Minimal_Parents_Size  : Positive := 16;
   Minimal_Children_Size : Positive := 16;
   Increment             : Natural  := 50;
   with function Equal (Left, Right : access Node_Type  ) return Boolean is <>;
   with function Equal (Left, Right : access Weight_Type) return Boolean is <>;
   with function Less  (Left, Right : access Node_Type  ) return Boolean is <>;
   with function Less  (Left, Right : access Weight_Type) return Boolean is <>;
package
Generic_Directed_Weighted_Graph is ...

The formal parameters are:

The package is similar to Generic_Directed_Graph. The following entities are equivalent:

The operations Find_Child, Get_Child, Get_Children (returning an array) are different in that respect that they are using the order determined by the comparisons of access Weight_Type specified by the corresponding formal functions Equal and Less.

The following operations are different or new:

procedure Classify
          (  Parent : Node;
             Weight : Weight_Type;
             Lower  : out Natural;
             Upper  : out Natural
          );

This procedure classifies the children of Parent according to the value of Weight. The output Lower is the position of the child node with the greatest weight less or equal to the value of Weight. When there is no such child Lower is 0. The output Upper is the position of the child node with the least weight greater or equal to the value Weight. When there is no such child Upper is the number of children + 1. The behavior of Classify ensures that when there is a child node with the weight equal to the value Weight, then Lower = Upper = the position of the child. Otherwise Lower + 1 = Upper. When Lower and Upper are valid positions of nodes, then the interval of weights corresponding to these nodes contains Weight. Constraint_Error is  propagated when Parent is null.

procedure Connect
          (  Parent  : Node;
             Child   : Node;
             Weight  : Weight_Type;
             Acyclic : Boolean := True
          );

This procedure creates a directed edge from Parent to Child with the weight specified by the parameter Weight. When the edge already exists and according to the formal comparison operations the weights are equivalent, this operation replaces the old weight with the value of Weight. When there is an edge from Parent  to a child node different from Child, with the weight equivalent to Weight according to the formal comparison operations of the weights, Argument_Error is propagated. It is also propagated when there is an edge from a parent node to Child, such that the node is different from Parent, but considered equivalent according to the formal operations of node comparisons. Additionally when Acyclic is true, it is checked that the new edge would not create a cycle in the graph, that is when Child would become or already is an ancestor of Parent. Otherwise Constraint_Error is propagated. Note that checking potentially requires traversal of all nodes of the graph. Constraint_Error is also propagated when either Parent or Child is null.

function Get_Weight (Parent : Node; Child : Positive) return Weight_Type;
function
Get_Weight (Parent : Node; Child : Node    ) return Weight_Type;

These functions return the weight of the edge Parent - Child. The child can be specified either by its position or else directly as a node. Constraint_Error is propagated when there is no such edge or else Parent or Child is null. The position of the node is determined  by the comparisons of access Weight_Type specified by the corresponding formal functions Equal and Less.

9.2.1. Suffix tree example

The example represents a straightforward implementation of suffix trees. The example is located in the test_components subdirectory.

File test_suffix_tree.ads:
with Generic_Directed_Weighted_Graph;
with Generic_Address_Order;

package Test_Suffix_Tree is
   type
Node_Type is null record;    -- Nodes have no contents
   type Default is access Node_Type; -- Default access type
   --
   -- Node_Order -- Ordering of nodes by their addresses
   --

   package Node_Order is new Generic_Address_Order (Node_Type);
   use Node_Order;
   --
   -- Ordering of the edge weights
   --

   function Equal (Left, Right : access Character) return Boolean;
   function Less  (Left, Right : access Character) return Boolean;
   --
   -- Directed graph of Node_Type weighted by Character values
   --

   package Character_Weighted_Graphs is
      new
Generic_Directed_Weighted_Graph
          (  Node_Type   => Node_Type,
             Weight_Type => Character,
             Pool        => Default'Storage_Pool,
             Minimal_Parents_Size => 1
          );
   subtype Suffix_Tree is Character_Weighted_Graphs.Node;
   --
   -- Build -- Creates the suffix tree from a string
   --

   function Build (Text : String) return Suffix_Tree;
   --
   -- Print -- Outputs the tree
   --

   procedure Print (Tree : Suffix_Tree; Prefix : String := "");

end Test_Suffix_Tree;

The package defines Node_Type as an empty record, since suffix tree nodes would contain no data. The order of nodes is irrelevant, therefore Generic_Address_Order is instantiated to provide some order of nodes. The type of edge weight is Character. The order of children nodes is determined by the weights of incoming edges. The operations Equal and Less use character comparison to order children. The instance of Generic_Directed_Weighted_Graph specifies Minimal_Parents_Size as 1, because tree has no more than one parent per node. Then the package declares two operations Build to create a tree and Print to output it onto the standard output.

File test_suffix_tree.adb:
with Ada.Text_IO;  use Ada.Text_IO;

package body Test_Suffix_Tree is
   use
Character_Weighted_Graphs;

   function Equal (Left, Right : access Character) return Boolean is
   begin
      return
Left.all = Right.all;
   end Equal;

   function Less (Left, Right : access Character) return Boolean is
   begin

      return Left.all < Right.all;
   end Less;

The implementation of Equal and Less is obvious.

File test_suffix_tree.adb (continuation):
   function Build (Text : String) return Suffix_Tree is
      Root  : Node := new Node_Type;
      Focus : Node;
      Lower : Natural;
      Upper : Natural;
   begin
      for
Index in Text'Range loop
         Focus := Root;
         for Current in Index..Text'Last loop
            Classify (Focus, Text (Current), Lower, Upper);
            if Lower = Upper then
               Focus := Get_Child (Focus, Lower);
            else
               declare

                  Branch : Node := new Node_Type;
               begin
                  Connect (Focus, Branch, Text (Current));
                  Focus := Branch;
               end;
            end if;
         end loop;
      end loop;
      return Root;
   end Build;

The implementation of Build creates the root node. Then it scans the string for its suffixes. For each suffix the tree is matched from the top. The procedure Classify is used to match the current character of the suffix against the edges of the current tree node. When an edge for the character exists the edge is followed. When no edge exists a new node is created connected by an edge weighted by the character and then this edge is followed.

File test_suffix_tree.adb (continuation):
   procedure Print (Tree : Suffix_Tree; Prefix : String := "") is
   begin
      for
Index in 1..Get_Children_Number (Tree) loop
         if
Index > 1 then
            Put (Prefix);
         end if;
         Put (Get_Weight (Tree, Index));
         Print (Get_Child (Tree, Index), Prefix & ' ');
      end loop;
      if Get_Children_Number (Tree) = 0 then
         New_Line;
      end if;
   end Print;

end Test_Suffix_Tree;

The package Test_Suffix_Tree can be used as follows:

with Test_Suffix_Tree;  use Test_Suffix_Tree;
                        use Character_Weighted_Graphs;
procedure Test is
 
  Tree : Suffix_Tree := Build ("mississippi");
begin
   Print (Tree);
   Delete (Tree);
end Test;

The output should look like:

ippi
 ssippi
    ssippi
mississippi
pi
 pi
sippi
  ssippi
 sippi
   ssippi


[Back][TOC][Next]

10. Lock-free data structures

Lock-free data structures provide shared access to their content without locking. For multi-core and other architectures of shared memory locking might be expensive compared to some extra overhead required for implementation of a lock-free access. So lock-free structures might appear more efficient. Another potential advantage of lock-free access is deadlock prevention. A sufficiently more complex use and less predictable behavior (mostly in the cases where a corresponding locking structure would block) count to the disadvantages of lock-free structures. The choice between lock-free and locking structure depends on each concrete case.

Here it is necessary to clarify what is understood under the term lock-free access. Clearly no processor instruction can be executed in a lock-free manner. There is always some sort of synchronization involved which ultimately is resulted in a non instant execution time. Neither a bounded access time is meant here, because a lock-free access can be interrupted and preempted.

In the context of the programming language Ada we define as lock-free any operations that are not:

  1. potentially blocking as it is defined in the Ada Language Reference Manual 9.5.1;
  2. involving calls to protected subprograms (ibidem), including protected functions, procedures and entries.

From this definition follows that in particular accessing atomic objects is lock-free. For atomic objects see the Ada Language Reference Manual C.6.

[Back][TOC][Next]

10.1. FIFO

10.1.1. Lock-free FIFO of definite elements

The package Generic_FIFO provides a lock-free first in, first out queue, which can be used between one publisher and one subscriber.

fifo

The package is generic:

generic
   type
Element_Type is private;
package
Generic_FIFO is ...

The type of FIFO is:

type FIFO (Size : Positive) is
   new
Ada.Finalization.Limited_Controlled with private;

The discriminant Size determines the maximal size of the queue. A queue can hold no more than Size - 1 elements. The following primitive operations are defined in the package:

procedure Delete (Queue : in out FIFO; Count : Natural := 1);

This procedure removes Count elements from Queue. When the queue contains Count or less elements, it becomes empty. The elements are removed from the same queue end Get and Peek access. Therefore it shall be called from the same task.

function Free_Space (Queue : FIFO) return Natural;

This function returns the maximum number of elements one can put into Queue.

procedure Get
          (  Queue   : in out FIFO;
             Element : out Element_Type;
             Empty   : out Boolean
          );

This function takes one element out of Queue. When Queue is empty the output parameter Empty is set to true and Element is not changed. Otherwise Element is the element taken and Empty is set to false.

function Get (Queue : FIFO) return Element_Type;

This is a variant of Get which raises Constraint_Error when Queue is empty.

function Is_Empty (Queue : FIFO) return Boolean;

This function returns true if Queue is empty.

function Is_Full (Queue : FIFO) return Boolean;

This function returns true if Queue is full.

function Is_Preserved (Queue : FIFO; Element : Element_Type)
   return Boolean;

This function returns true if Element has to be preserved in Queue by the procedure Purge. This is the default behavior. The function can be overridden in order to change the behavior of Purge.

procedure Peek
          (  Queue   : FIFO;
             Element : out Element_Type;
             Empty   : out Boolean
          );

This function returns the element of Queue, a Get operation would take. Unlikely to Get it does not remove the element from Queue. When Queue is empty the output parameter Empty is set to true and Element is not changed. Otherwise Element is the element at the Queue beginning and Empty is set to false.

function Peek (Queue : FIFO) return Element_Type;

This is a variant of Peek which raises Constraint_Error when Queue is empty.

procedure Purge
          (  Queue  : in out FIFO;
             Purged : out Natural
          );
procedure Purge
          (  Queue        : in out FIFO;
             Is_Preserved : Is_Preserved_Ptr;
             Purged       : out Natural
          );

This procedure removes all elements for which Is_Preserved returns false. The parameter Purged is set to the number of elements removed from the Queue. The default implementation of Is_Preserved returns true, so it needs to be overridden to make Purge removing any element. Observe also that there is a potential race condition in Purge when new elements are added concurrently. The newly added elements might be not removed. If it is essential to remove the race condition, the implementation of Is_Preserved must return false for newly added elements.

procedure Put
          (  Queue   : in out FIFO;
             Element : Element_Type;
             Full    : out Boolean
          );

This procedure places Element into Queue. When Element is put, Full is set to false. Otherwise it is set to true.

procedure Put
          (  Queue   : in out FIFO;
             Element : Element_Type;
          );

This is a variant of the procedure above which raises Constraint_Error when Queue is full.

10.1.2. Signaled FIFO of definite elements

The child package Generic_FIFO.Signaled_FIFO provides FIFO with almost lock-free behavior. The implementation locks only if the operation has to block. That is, upon reading from an empty queue or else writing into a full queue. Otherwise it is lock-free.

generic
package
Generic_FIFO.Generic_Signaled is ...

The type of Signaled_FIFO is:

type Signaled_FIFO is new FIFO with private;

The following operations are added or have an altered behavior:

procedure Cancel (Queue : in out Signaled_FIFO);

This procedure releases all blocked tasks. Get and Peek called for an empty queue, as well as Put called for a full queue are blocked. Their waiting is prematurely ended when Cancel is called. In this case End_Error is propagated out the corresponding calls. Note that differently to Get, Peek and Put, this procedure can be called from any task.

function Get (Queue : Signaled_FIFO) return Element_Type;
function
Get (Queue : Signaled_FIFO; Timeout : Duration)
   return Element_Type;

These functions block when Queue is empty. If a timeout is specified, upon its expiration, Contraint_Error is propagated as it would for the parent type. End_Error is propagated when waiting was prematurely cancelled by a call to Cancel.

function Peek (Queue : Signaled_FIFO) return Element_Type;
function
Peek (Queue : Signaled_FIFO; Timeout : Duration)
   return Element_Type;

These functions block when Queue is empty. If a timeout is specified, upon its expiration, Contraint_Error is propagated. End_Error is propagated when waiting was prematurely cancelled by a call to Cancel.

procedure Put
          (  Queue   : in out Signaled_FIFO;
             Element : Element_Type;
          );
procedure
Put
          (  Queue   : in out Signaled_FIFO;
             Element : Element_Type;
             Timeout : Duration
          );

These procedures block when Queue is full. If a timeout is specified, upon its expiration, Contraint_Error is propagated. End_Error is propagated when waiting was prematurely cancelled by a call to Cancel.

10.1.3. Lock-free FIFO of indefinite elements

The package Generic_Indefinite_FIFO provides a lock-free first in, first out queue, which can be used between one publisher and one subscriber. It is similar to Generic_FIFO except that it can handle elements of indefinite types, such as unconstrained arrays or class-wide types. The package is generic:

generic
   type
Element_Type (<>) is private;
package
Generic_Indefinite_FIFO is ...

The type of FIFO is:

type FIFO (Size : Storage_Count) is
   new
Ada.Finalization.Limited_Controlled with private;

The discriminant Size determines the maximal size of the queue in storage elements. A queue can hold objects which total size in storage elements is no more than Size - 1. This is not the exact limit, which could be lower due to memory fragmentation. There can be no more than two fragments, except than small holes needed for alignment reasons. Note that because the element size is unknown in advance, it is impossible to determine whether the queue is full

The following primitive operations are defined in the package:

procedure Delete (Queue : in out FIFO; Count : Natural := 1);

This procedure removes Count elements from Queue. When the queue contains Count or less elements, it becomes empty. The elements are removed from the same queue end Get and Peek access. Therefore it shall be called from the same task.

function Get (Queue : FIFO) return Element_Type;

This function returns one element from Queue. The element is removed from the queue. Constraint_Error is propagated when the queue is empty.

function Free_Space (Queue : FIFO) return Storage_Count;

This function returns the maximal available space in Queue. Note that the result greater than the element size does not yet guarantee a consequent Put would not fail. The queue space can be fragmented up to two segments. Therefore only when the result is twice as required then Put will not fail.

function Is_Empty (Queue : FIFO) return Boolean;

This function returns true if Queue is empty.

function Peek (Queue : FIFO) return Element_Type;

This function is similar to Get except that it does not remove the element from Queue. Constraint_Error is propagated when the queue is empty.

procedure Put
          (  Queue   : in out FIFO;
             Element : Element_Type
          );
procedure
Put
          (  Queue   : in out FIFO;
             Element : Element_Type;
             Full    : out Boolean
          );

This procedure put Element into Queue. Constraint_Error when Queue does not have enough space for Element. The variant with the Full output parameter is exception-free. Full is set to true if the element was successfully pot into the FIFO and false otherwise.

10.1.4. Signaled FIFO of indefinite elements

The child package Generic_Indefinite_FIFO.Signaled_FIFO provides FIFO with almost lock-free behavior. The implementation locks only if the operation has to block. That is, upon reading from an empty queue or else writing into a full queue. Otherwise it is lock-free.

generic
package
Generic_Indefinite_FIFO.Generic_Signaled is ...

The type of Signaled_FIFO is:

type Signaled_FIFO is new FIFO with private;

The following operations are added or have an altered behavior:

procedure Cancel (Queue : in out Signaled_FIFO);

This procedure releases all blocked tasks. Get and Peek called for an empty queue, as well as Put called for a full queue are blocked. Their waiting is prematurely ended when Cancel is called. In this case End_Error is propagated out the corresponding calls. Note that differently to Get, Peek and Put, this procedure can be called from any task.

function Get (Queue : Signaled_FIFO) return Element_Type;
function
Get (Queue : Signaled_FIFO; Timeout : Duration)
   return Element_Type;

These functions block when Queue is empty. If a timeout is specified, upon its expiration, Contraint_Error is propagated as it would for the parent type. End_Error is propagated when waiting was prematurely cancelled by a call to Cancel.

function Peek (Queue : Signaled_FIFO) return Element_Type;
function
Peek (Queue : Signaled_FIFO; Timeout : Duration)
   return Element_Type;

These functions block when Queue is empty. If a timeout is specified, upon its expiration, Contraint_Error is propagated. End_Error is propagated when waiting was prematurely cancelled by a call to Cancel.

procedure Put
          (  Queue   : in out Signaled_FIFO;
             Element : Element_Type;
          );
procedure
Put
          (  Queue   : in out Signaled_FIFO;
             Element : Element_Type;
             Timeout : Duration
          );

These procedures blocks when Queue is full. If a timeout is specified, upon its expiration, Contraint_Error is propagated. End_Error is propagated when waiting was prematurely cancelled by a call to Cancel.

[Back][TOC][Next]

10.2. Blackboard

Blackboard is a data structure of broadcasted messages. Publishers put their messages (elements) onto the blackboard. The blackboard elements remain accessible there for the subscribers until newly put elements override them. The elements order in the blackboard is first in, first out. Accessing the blackboard for read is lock-free. Additionally the blackboard provides mechanisms for elements identification and enumeration. When an element is put into the blackboard it receives a unique reference. The reference can be used to access the element so long it is in the blackboard. After element expiration a reference can still be used to determine this condition. References can be advanced to the next element or else to the first not yet expired element in the blackboard.

blackboard

10.2.1. Single publisher blackboard

The package Generic_Blackboard provides a blackboard safe to use with one publisher writing into it, and any number of subscribers accessing it only for read. The package is generic:

generic
   type
Element_Type (<>) is private;
package
Generic_Blackboard is ...

The generic parameter is the type of the elements in the blackboard.  The elements are stored in the blackboard temporarily. Newly coming elements override the most elder ones. The elements can be indefinite, tagged and class-wide. However

Because the elements in the blackboard are destructed automatically in an implicit way, it is not allowed to use elements of controlled types as well as of any other types requiring non-null finalization.

The type of a blackboard is:

type Blackboard (Size : Storage_Count) is
   new
Ada.Finalization.Limited_Controlled with private;

The discriminant Size determines the size of the blackboard in storage elements. The time an element survives in the blackboard depends on the blackboard size, the size of the elements and on how frequently elements are put into it. The elements in the blackboard are accessed through references which know if the destination is still valid:

type Reference is private;

When the compiler does not support atomic access to 64-bit integers, an alternative version based on GCC's built-in functions must be used. See scenario variables. Precompiled distributions select an appropriate implementation automatically.

The following primitive operations are defined in the package:

function First (Storage : Blackboard) return Reference;

This function returns a reference to the first element available in Storage. Note that this function can return an invalid reference when used concurrently. It that case the caller should call it again, unless the result is greater than Storage according to >. Together with Next, this function can be used to scan the elements of a blackboard.

function Get (Storage : Blackboard; Pointer : Reference)
   return Element_Type;

This function returns an element by reference. Constraint_Error is propagated when Pointer is not a valid reference. Note that any reference can become invalid when the blackboard is being written.

function Image (Pointer : Reference) return String;

This function returns a text representation of Pointer.

function Is_Valid (Storage : Blackboard; Pointer : Reference)
   return
Boolean;

This function returns true if Pointer is a valid reference in Storage. It is equivalent to not Storage > Pointer and not Storage < Pointer.

procedure Next
          (  Storage : Blackboard;
             Pointer : in out Reference;
             Sequent : out Boolean
          );

This procedure advances the reference Pointer to the next element. When Pointer is valid and there is a next element then Sequent is set to true and Pointer will refer to that element. When Pointer refers to a lost element then it is set to the first available element and Sequent is set to false. When Pointer refers to a not yet available element, it is not changed and Sequent is set to true. The following code snippet illustrates how Next can be used to scan a blackboard:

Data : Blackboard;
   ...
task body Scanner is
   Element : Reference;
   Sequent : Boolean;
begin
   Element := First (Data); -- The first element
   loop
      if not
(Element > Data) then
         begin
           
... Get (Data, Element) ... -- Use element
         exception
            when
Constraint_Error =>
               ... -- The element is lost
         end
;
        
Next (Data, Element, Sequent);
         if not
Sequent then
           
... -- Some elements were lost
         end if
;
      else
         delay
0.010;  -- Wait for new elements to come
      end if
;
   end loop
;
end Scanner;

Note that lost elements can be detected by the scanner. This is the best what a scanner could have, because blackboard is a lock-free structure and it cannot block the publisher writing into it

procedure Next
          (  Storage : Blackboard;
             Pointer : in out Reference;
             Sequent : out Boolean
          );

This procedure advances the reference Pointer to the next element. When Pointer is valid and there is a next element then Sequent is set to true and Pointer will refer to that element. When Pointer refers to a lost element then it is set to the first available element and Sequent is set to false. When Pointer refers to a not yet available

procedure Put
          (  Storage : in out Blackboard;
             Element : Element_Type;
             Pointer : out Reference
          );
procedure
Put
          (  Storage : in out Blackboard;
             Element : Element_Type
          );

These procedures put Element into Storage and returns a reference to it, when the parameter Pointer is used. The operation overrides the most outdated items in the blackboard making references to them invalid. Storage_Error is propagated when Element is too large to fit into Storage even if it alone there. The procedure is the only one which shall be used from one task or else exclusively.

procedure Put
          (  Storage  : in out Blackboard;
             Element  : Element_Type;
             Preserve : Reference;
             Pointer  : out Reference
             Success  : out Boolean
          );
procedure
Put
          (  Storage  : in out Blackboard;
             Element  : Element_Type
             Preserve : Reference;
             Success  : out Boolean
          );

These are variants of Put, which prevent overriding of the items referenced by Preserve and later. The parameter Success is set to true when Element was successfully put into Storage. It is set to false when Element was not put, because there is no room in Storage without removing protected items.

function Upper (Storage : Blackboard) return Reference;

This function returns the least upper bound of Storage. That is the reference to the element which will be put next into.

function "<" (Storage : Blackboard; Pointer : Reference)
   return Boolean;
function ">" (Storage : Blackboard; Pointer : Reference)
   return Boolean;
function "<" (Pointer : Reference; Storage : Blackboard)
   return Boolean;
function ">" (Pointer : Reference; Storage : Blackboard)
   return Boolean;

These functions provide reference validity checks. Storage < Pointer, when Pointer refers to an element not yet written into the blackboard. The procedure Next returns such reference when it reaches the end of a blackboard. Storage > Pointer, when Pointer refers to a lost element, which is already overridden by newer elements. When neither Storage < Pointer nor Storage > Pointer, then Pointer is refers to an accessible (valid) element in Storage. In other words comparisons are made in the sense of intervals, when the blackboard is considered as a consequent range of contained elements. Because the blackboard elements are written in FIFO order, the following statement is true:

Let S1, S2 be the states of a blackboard S at the times t1t2. P1, P2 be the states of a reference P to the same blackboard element at the corresponding times, then

    S1>P1 => S2>P2
    S2<P2 => S1<P1

function "<"  (Left, Right : Reference) return Boolean;
function ">"  (Left, Right : Reference) return Boolean;
function "<=" (Left, Right : Reference) return Boolean;
function ">=" (Left, Right : Reference) return Boolean;

References are directly comparable even if not valid. Elements put later onto the blackboard have greater references.

First_Reference : constant Reference;

This value is of a reference to the first blackboard element.

10.2.2. Multiple publishers blackboard

The child package Generic_Blackboard.Generic_Task_Safe provides a blackboard, which is safe to use with any number of publishers:

generic
package
Generic_Blackboard.Generic_Task_Safe is ...

The package provides a derived blackboard type:

type Shared_Blackboard is new Blackboard with private;

This type overrides the procedure Put with an implementation that uses a protected subprogram in order to write the blackboard in a task safe way.


[Back][TOC][Next]

11. Locking synchronization primitives

The package Synchronization is a parent package of the child packages providing various locking synchronization primitives. The package defines:

Cancel_Error    : exception;
Ownership_Error : exception;
Timeout_Error   : exception;

[Back][TOC][Next]

11.1. Notes on programming with protected objects

Here it is appropriate to discuss some techniques used in Ada for task synchronization. There exist two major mechanisms of synchronization in Ada:

Rendezvous is a synchronous call to an entry of a task. As such it cannot be reused unless the task types have multiple instances. It is also considered heavy-weight because it often requires context switching. However, rendezvous and protected objects should not be considered competing. There exist problems more natural to solve with rendezvous than with protected objects, and the inverse.

A protected object has a state and three types of operations to handle its state:

The difference between protected procedures and entries is in the queue. When a protected procedure is called that never blocks the caller task. When an entry is called that potentially blocks.

Non-blocking does not imply any specific time constraint. In fact a non-blocking call to a protected object may result in some delay. It is also possible that the task doing it would in effect lose the processor. Non-blocking only means that the waiting time does not depend on either the program logic or its inputs. So it is considered "instant" from the program point of view. Blocking means that the program logic can become aware of the delay caused by the call. For example, I/O is considered blocking. The program shall be prepared to deal with blocking. This is one reason why entries and procedures are distinct in protected objects.

When an entry call blocks the caller task spends its time in the queue of the entry. Each entry also has a barrier, a condition which opens or closes the entry. When an entry is open, a task calling to the entry can be unblocked in order to execute the entry body. When the entry is closed, the task is blocked and stays in the entry queue. The barrier depends on the protected object state. Though it is possible to refer to non-local variables from the barrier, that would be useless because the barriers are re-evaluated only when the protected object state is "officially" changed. And this happens only when a protected procedure or an entry body is executed.

The actual parameters and global variables cannot be used in the barriers. That is quite limiting. Fortunately, there exists a technique to circumvent this constraint. The technique is based on the requeue statement (see Ada Language Reference Manual 9.5.4, which is one the most powerful constructs of the Ada concurrency model. A task queued to a protected object entry can be re-queued to another entry under the condition that the parameter profile is same or else that the new entry does not have any parameters. Requeue is used in the "lounge" pattern discussed below.

Let us consider creating a shared counter. A counter can be incremented. It can be awaited for reaching some definite value. The interface of such a counter might look as follows:

protected type Counter is
   entry
Wait (Goal : Natural); -- Wait for Goal >= Value
   procedure Count;             -- Increment counter
private
   Value : Natural := 0;        -- The current counter state
end Counter;

The procedure Count increments the counter value by 1. The entry Wait is used in order to wait for a state when Goal is greater than or equal to the counter value. This condition cannot be specified as the barrier of Wait. The solution of the problem is to add a private family of entry points Lounge:

protected type Counter is
   entry
Wait (Goal : Natural);   -- Wait for Goal >= Value
   procedure Count;               -- Increment counter
private
   entry
Lounge (Boolean) (Goal : Natural); -- Callers are waiting here
   Value   : Natural := 0;                  -- The current counter state
   Current : Boolean := False;              -- The current update state
end Counter;

The implementation of Wait has the barrier true (no waiting). It checks if the condition is met and otherwise re-queues to the entry Lounge, where the caller task will actually wait for the condition to meet.

entry Wait (Goal : Natural) when True is
begin
   if
Goal > Value then -- Enter actual waiting if not met
      requeue Lounge (not Current) with abort;
   end if
;
end Wait;

The barrier of Lounge is informally "object's state has changed." This also cannot be spelt using the object's state alone. But it can be done using entry families. So the entry Lounge is split into two. In the declaration of it has (Boolean) following the entry name, which means, there exists Lounge (True) and Lounge (False). The object itself is in two states reflected by the variable Current. When Current is true, Lounge (True) is open and Lounge (False) is closed. When Current is false, they change places. The procedure Count increments the counter and then toggles Current. This causes tasks queued to a Lounge to execute the body and releases those of them the counter state reached Goal. Others are requeued back to the opposite Lounge entry:

entry Lounge (for Toggle in Boolean) (Goal : Natural)
   when Toggle = Current is
begin
   if
Goal < Value then   -- Continue waiting if not met
      requeue Lounge (not Current) with abort;
   end if
;
end Lounge;

The procedure Count increments Value and switches lounges:

procedure Count is
begin
  
Value   := Value + 1;   -- Increment counter
   Current := not Current; -- Pulse state change
end Count;

Here a careful reader could observe that this solution has a race condition, when Count toggles Current, there is no guarantee that all tasks from the corresponding Lounge's queue will execute the Lounge's body before next increment. In order to ensure that, a final step has to be done:

protected type Counter is
   entry
Wait (Goal : Natural); -- Wait for Goal >= Value
   entry Count;                 -- Increment counter
private
   entry
Lounge (Boolean) (Goal : Natural); -- Callers are waiting here
   Value   : Natural := 0;                  -- The current counter state
   Current : Boolean := False;              -- The current update state
end Counter;

Here Count becomes an entry. This allows us to lock it when the queue of a Lounge from the previous notification step is not yet empty.

entry Count when Lounge (Current)'Count = 0 is
begin
  
Value   := Value + 1;   -- Increment counter
   Current := not Current; -- Pulse state change
end Count;

Though Count is now an entry it does not really block.

The "lounge" pattern is considerably universal. In fact, the implementations of the most of the synchronization primitives described below are based on this pattern.

[Back][TOC][Next]

11.2. Events

An event is a synchronization object with a state, that can be changed and awaited for. As a synchronization primitive event is very low-level, and thus, is exposed to various problems from race condition to deadlocking. For this reason they should be used with a great care.

11.2.1. Simple event

The package Synchronization.Events provides an implementation of a simple event. An event can be signaled, reset, and awaited for a definite state. Note that if the events need to be used in a combination the package Synchronization.Generic_Events_Array should be used instead. The event is signaled and reset manually, which can be a source of race condition when signaling is close followed by resetting. Such events represent a special case pulse events. See the package Synchronization.Pulse_Events which provides a race condition safe implementation of.

protected type Event is ...

This is the type of the protected object implementing an event. The following subprograms and entries are provided:

function Is_Signaled return Boolean;

This function returns true if the event is signaled.

procedure Reset;

This procedure sets the event into the non-signaled state. It releases all tasks queued to the entry Wait_For_Reset.

procedure Signal;

This procedure signals the event. It releases all tasks queued to the entry Wait.

entry Wait;

This entry blocks until the event is signaled.

entry Wait_For_Reset;

This entry blocks until the event is signaled.

11.2.2. Pulse event

The package Synchronization.Pulse_Events provides an implementation of pulse events. A pulse event is signaled for a short, actually indivisible, period of time. It is reset automatically immediately after the last task awaiting the event is released. The implementation provided by this package is free of race conditions. That is, even if a task, released by the event, seized the processor before releasing other tasks, and then entered another wait for the same event, that would not release this task again. It will be blocked until a next pulsation of the event. The implementation also ensures that all tasks entering waiting before event pulsation are released before any consequent pulsation. The following diagram illustrates the constraints satisfied by the implementation in order to prevent race conditions:

pulse event

As the diagram shows both pulsing and waiting are postponed until the end of releasing already blocked tasks. Any task entering waiting stay blocked while other tasks are released.

protected type Pulse_Event is ...

This is the type of the protected object implementing a pulse event. The following subprograms and entries are provided:

entry Pulse;

This entry release all tasks waiting for the event. Note that though this is an entry, it does not block for any considerable time. When accepted, it releases all tasks queued to the entry Wait before any next Pulse takes effect.

entry Wait;

This entry waits for an event pulsation (see Pulse).

11.2.3. Events pulsing a value

The package Synchronization.Generic_Pulse_Events is a generic variant of Synchronization.Pulse_Events which additionally distributes a value when an event is pulsed. The package is generic:

generic
   type
Event_Value is private;
package
Synchronization.Generic_Pulse_Events is ...

The formal generic parameter is the type of the values distributed when the event is pulsed.

protected type Pulse_Event is ...

This is the type of the protected object implementing a pulse event. The following subprograms and entries are provided:

entry Pulse (Value : Event_Value);

This entry release all tasks waiting for the event and propagates Value to each of them. Note that though this is an entry, it does not block for any considerable time. When accepted, it releases all tasks queued to the entry Wait passing Value to all of them. Any consequent Pulse is blocked until end of releasing the tasks.

entry Wait (Value : out Event_Value);

This entry waits for event pulsing by Pulse. The parameter Value is the value specified in the call to Pulse.

11.2.4. Arrays of events

The package Synchronization.Generic_Events_Array provides arrays of events. The objective of the design is to allow waiting for any combination of the events. The events from the array can be signaled, reset and awaited for. The implementation represented here is free of race conditions, when the state of the events is being changed. In this case it guarantees that all tasks awaiting for the state are released before any consequent state change. Another common class of race conditions is eliminated by providing atomic signal-then-wait operations. For instance a set of tasks may synchronize themselves at dedicated points by signaling an event and then awaiting for all events signaled. If tasks later reset their events, that would constitute a race condition, because a task might reset its event before other tasks queued for all events set. The following figure illustrates the case:

events array deadlock

In this example the deadlock of the task B is caused by a premature resetting the event A. An atomic signaling and waiting breaks the deadlock.

The package is generic

generic
   type
Event_Type is (<>);
package
Synchronization.Generic_Events_Array is ...

The formal parameter is the index type of the events array. The package defines the following supplementary types:

type Events_State is array (Event_Type) of Boolean;

Objects of this type describe the state of an events array. For each event Event_State contains true if the event is signaled. The following set-theoretic operations are defined additionally to the standard operations of Boolean arrays in order to ease composition of arrays:

function "or" (Left, Right : Event_Type) return Events_State;
function "or" (Left : Events_State; Right : Event_Type)   return Events_State;
function "or" (Left : Event_Type;   Right : Events_State) return Events_State;

These functions compose a set when one parameter specifies an event.

function "not" (Left : Event_Type) return Events_State;

This function creates a complement set of a singleton event.

type Abstract_Condition is abstract
   new
Ada.Finalization.Controlled with null record;

This type represents an abstract condition to wait for. The entries of the events array awaits for instances of the types derived from this base type. The derived type shall override the abstract primitive operation Satisfied. User-defined conditions can be created by deriving from this type.

function Satisfied
         (  Condition : Abstract_Condition;
            State     : Events_State
         )  return Boolean is abstract;

This function is used to check if the condition is satisfied. The parameter State is the current state of the events array. Note that the function is called in the course of a protected action. That means, that it shall neither block, nor invoke any other protected actions. Further if it accesses shared non-local data, the user shall warranty that these data are either atomic or else are never accessed outside the protected actions of Events_Array.

The package provides some frequently used conditions:

Always_Signaled : constant Abstract_Condition'Class;
All_Signaled    : constant Abstract_Condition'Class;
Any_Signaled    : constant Abstract_Condition'Class;
No_Signaled     : constant Abstract_Condition'Class;

The conditions:

Further conditions are specified using the type Event_Signaled derived from Abstract_Condition.

type Event_Signaled (Event : Event_Type) is
   new
Abstract_Condition with null record;

The type represents a condition that the event corresponding to the value of the discriminant Event is signaled. Instances of this type can be created using the following function.

function Signaled (Event : Event_Type) return Event_Signaled;

This function returns a condition satisfied when Event is signaled.

function Reset (Event : Event_Type) return Event_Reset;

This function returns a condition satisfied when Event is not signaled.

protected type Events_Array is ...

Protected objects of this type represent arrays of events. Initially all events in the array are non-signaled. The following operations and entry points are defined for Events_Array:

function Get_State return Events_State;

This function returns the state of the array. The result is an array which for each event contains true if the event is signaled.

function Is_Signaled (Event : Event_Type) return Events_State;

This function returns true if Event is signaled.

entry Reset
      (  Events    : Events_State;
         Condition : Abstract_Condition'Class := Always_Signaled
      );
entry Reset
      (  Event     : Event_Type;
         Condition : Abstract_Condition'Class := Always_Signaled
      );

These entries reset an event or a number of events to the non-signaled state. When the first parameter specifies an event, then the event is set to the non-signaled state. When the parameter is an array, then each event for which the array contains true is reset to the non-signaled state. The parameter Condition is the condition to wait for immediately after resetting the events. The default value is Always_Signaled, i.e. Reset returns after changing the events without waiting. Entering waiting, if any, is indivisible from resetting the events.

entry Signal
      (  Events    : Events_State;
         Condition : Abstract_Condition'Class := Always_Signaled
      );
entry Signal
      (  Event     : Event_Type;
         Condition : Abstract_Condition'Class := Always_Signaled
      );

These entries signal an event or a number of events. When the first parameter is an event, then the event is signaled. When the parameter is an array, then each event for which the array contains true is signaled. The parameter Condition is the condition to wait for immediately after signaled the events. The default value is Always_Signaled, i.e. Signal returns after changing the events without waiting. Entering waiting, if any, is indivisible from signaling the events.

entry Set
      (  State     : Events_State;
         Condition : Abstract_Condition'Class := Always_Signaled
      );

This entry sets all events according to the value of State. The parameter Condition specifies the condition to wait for, immediately after setting the events. The default value is Always_Signaled, i.e. Set returns after changing the events without waiting. Entering waiting, if any, is indivisible from setting the events.

entry Wait (Condition : Abstract_Condition'Class);

This entries waits for Condition. See also Signal, Reset and Set entries which also are capable of waiting for a certain condition.

11.2.5. Synchronization at a checkpoint. Sample

The following example illustrates use of the package for checkpoint synchronization problem: The problem arise when several tasks perform some jobs and need to be synchronized when all jobs are completed. A job completion is signaled by an event. A task completing its job signals the event, waits for other events signaled and then resets the event. This procedure is exposed to race conditions and deadlocks.

File test_synchronization_events_array.ads:
with Synchronization.Generic_Events_Array;

package Test_Synchronization_Events_Array is
   type
Worker_ID is (A, B, C);
   package Events_Arrays is
      new 
Synchronization.Generic_Events_Array (Worker_ID);
end Test_Synchronization_Events_Array;

This package instantiates Synchronization.Generic_Events_Array, which is necessary to do at the library level in Ada 95. In Ada 2005 it can be instantiated in nested scopes.

File test_synchronization_events.adb (part of) :
   ...
with Ada.Numerics.Float_Random;  use Ada.Numerics.Float_Random;
with Ada.Text_IO;                use Ada.Text_IO;

with Test_Synchronization_Events_Array;
use  Test_Synchronization_Events_Array;
use  Events_Arrays;
   ...
Worker_State : Events_Array;

task type Worker (ID : Worker_ID);
task body Worker is
   Dice : Generator;
begin
   Reset (Dice);
   for Index in 1..10 loop
      Put_Line
      (  Worker_ID'Image (ID)
      &  " doing things"
      &  Integer'Image (Index)
      );
      delay Duration (Random (Dice) * 0.100);
      Worker_State.Signal (ID, All_Signaled);
      Worker_State.Reset (ID);
   end loop;
   Put_Line (Worker_ID'Image (ID) & " finished");
end Worker;

T1 : Worker (A);
T2 : Worker (B);
T3 : Worker (C);

Here three tasks perform some piece of work. The work is simulated by waiting for a random period of time. At the end of each cycle a worker sets its event in the array of the events Worker_State. Then it waits for other workers. This action is performed atomically by:

Worker_State.Signal (ID, All_Signaled);

Here ID is the worker/event identifier and All_Signaled is a condition satisfied when all events are set. After this the worker resets its event

Worker_State.Reset (ID);

and starts a new iteration of the cycle.

[Back][TOC][Next]

11.3. Mutexes

Mutex stands for Mutual Exclusion. It is a synchronization object used to prevent concurrent access to a resource. A more general but rarely used in practice concept is semaphore introduced by Edsger Dijkstra. Technically mutex is a semaphore with the count k=1. The count 1 means that only one task can own the mutex at a time. Mutexes are exposed to deadlocks when a task attempts to seize more than one mutex. It is enough to have two tasks and two mutexes in order to be able to construct a deadlock. Yet another problem is resource starvation caused by a premature termination of a task owning the mutex, for example, upon exception propagation.

11.3.1. Reentrant mutex

The package Synchronization.Mutexes provides an implementation of mutexes, free of one particular problem, when a mutex is repetitively seized by the same task. The implementation avoids deadlock by allowing a task to seize the mutex more than once.

protected type Mutex is ...

Protected objects of this type represent mutexes. The following operations and entry points are defined for Mutex:

function Get_Owner return Task_ID;

This function returns the identification of the task owning the mutex. See the standard package Ada.Task_Identification for further information.

procedure Grab;

This procedure seizes the mutex if it is not owned by another task. Is_Mine can be used afterwards in order to verify if the mutex was indeed seized. When the mutex was seized it shall be released by a call to Release. For example:

   Resource : Mutex;    -- A resource
  
...
begin
   ...
   Resource.Grab;       -- Try to seize it without blocking
   if Resource.Is_Mine then
      ...               -- Use the resource safely
      Resource.Release; -- Note, it has to be released
   end if;

function Is_Mine return Boolean;

This function returns true if the mutex is owned by the caller task.

function Is_Owned return Boolean;

This function return true if the mutex is owned by a task.

procedure Release;

This procedure releases the mutex previously seized by Grab or Seize. Note that each call to Seize and each call to Grab that seized the mutex shall be matched by a call to Release. Ownership_Error is propagated when the mutex is not owned by the caller task.

entry Seize;

This entry is used to seize the mutex. It blocks until the mutex becomes free. It does not block if the mutex is already owned by the caller task. Each call to Seize shall be matched by a call to Release.

The package also defines:

type Holder (Resource : access Mutex) is
   new
Ada.Finalization.Limited_Controlled with private;

This is a helper type used to ensure that each Seize is matched by a Release even if an exception is propagated. It is used as follows:

   Resource : aliased Mutex; -- A resource
  
...
begin
   ...
   declare
      Lock : Holder (Resource'Access); -- Seize the resource
   begin
      ...  -- Enjoy exclusive access
   end  -- Release the resource

It is strongly recommended to use a Holder object in order to access a mutex even if that might cause some overhead. The reason is that asynchronous transfer of control (Language Reference Manual 9.7.4)) from a task owning a mutex might leave the mutex seized. A Holder object warranties mutex release. In general one should avoid asynchronous transfer of control.

11.3.2. Arrays of mutexes

The package Synchronization.Generic_Mutexes_Array provides an implementation of arrays of mutexes. Arrays of mutexes are deadlock free. The deadlock is prevented by numerous measures:

The package is generic:

generic
   type
Mutex_Type is (<>);
package
Synchronization.Generic_Mutexes_Array is ...

The formal parameter is the index type of the mutexes array. The package defines the following supplementary types:

type Mutexes_Set is array (Mutex_Type) of Boolean;

This is a set of mutexes. For each mutex event Mutexes_Set contains true if the mutex is in the set. The following set-theoretic operations are defined additionally to the standard operations of Boolean arrays in order to ease composition of arrays:

function "or" (Left, Right : Mutex_Type) return Mutexes_Set;
function "or" (Left : Mutexes_Set; Right : Mutex_Type)   return Mutexes_Set;
function "or" (Left : Mutex_Type;  Right : Mutexes_Set) return Mutexes_Set;

These functions compose a set when one parameter specifies an event.

function "not" (Left : Mutex_Type) return Mutexes_Set;

This function creates a complement set of a singleton event.

protected type Mutexes_Array is ...

Protected objects of this type represent arrays of mutexes. The following operations and entry points are defined for Mutexes_Array:

function Get_Owner (Mutex : Mutex_Type) return Task_ID;

This function returns the identification of the task owning Mutex. See the standard package Ada.Task_Identification for further information.

procedure Grab (Mutex : Mutex_Type);
procedure Grab (Mutex : Mutex_Type; Success : out Boolean);

This procedures seize Mutex if it is not already owned by another task. Is_Mine can be used after Grab in order to verify if the mutex was indeed seized. When the mutex was seized is shall be released later by a call to Release or Release_All with the same mutex specified. For example:

   Resource : Mutexes_Array; -- Resources
  
...
begin
   ...
   Resource.Grab (Mutex);       -- Try to seize it without blocking
   if Resource.Is_Mine (Mutex) then
      ...                       -- Use the resource safely
      Resource.Release (Mutex); -- Note, it has to be released
   end if;

The variant with the output parameter Success sets the parameter to true if the mutex was seized or to false otherwise. When Mutex is to be seized and has the position less than one of a mutex already owned by the caller task, Ownership_Error is propagated.

procedure Grab_All (Mutexes : Mutexes_Set; Success : out Boolean);

This procedures seizes all Mutexes. If at least one mutex from Mutexes is not already owned by another task the procedure does nothing and Success is set to false. When mutexes are seized Success is set to true. Each mutex seized by Grab_All has to be released by a matching call to Release or Release_All. When Mutexes contains a mutex to be seized such that its position less than one of a mutex already owned by the caller task, yet not appearing in Mutexes, then Ownership_Error is propagated.  In this case the operation has no side effect on the mutexes array.

function Is_Mine (Mutex   : Mutex_Type)  return Boolean;
function Is_Mine (Mutexes : Mutexes_Set) return Boolean;

This function returns true if Mutex is owned by the caller. The variant with a set returns true if all mutexes from the set are owned by the caller.

function Is_Owned (Mutex : Mutex_Type) return Boolean;

This function returns true if Mutex is owned by a task.

procedure Release (Mutex : Mutex_Type);

This procedure releases Mutex previously seized by Grab, Grab_All, Seize or Seize_All. For each mutex the number of seizures shall match the number of releasing. Ownership_Error is propagated when Mutex is not owned by the caller.

procedure Release_All (Mutexes : Mutexes_Set);

This procedure releases all mutexes from Mutexes previously seized by Grab, Grab_All, Seize or Seize_All. For each mutex the number of seizures shall match the number of releasing. Ownership_Error is propagated when at least one mutex is not owned by the caller. The procedure might release some of the mutexes before propagating the exception.

entry Seize (Mutex : Mutex_Type);

This entry is used to seize Mutex. It blocks until the mutex becomes free. It does not block if the mutex is already owned by the caller. Each call to Seize shall be matched by a call to Release or Release_All with the same mutex specified. When Mutex has the position less than one of a mutex already owned by the caller task, Ownership_Error is propagated.

entry Seize_All (Mutexes : Mutexes_Set);

This entry is used to seize all mutexes from Mutex. It blocks until the mutexes become available. It does not block if all mutexes are already owned by the caller. For each mutex specified in a call to Seize_All there shall be a matching call  to Release or Release_All. When Mutexes contains a mutex with the position less than one of a mutex already owned by the caller task, yet not appearing in Mutexes, then Ownership_Error is propagated. In this case the operation has no side effect on the mutexes array.

The package also defines two helper types:

type Set_Holder
     (  Resource : access Mutexes_Array;
        Seize    : access Mutexes_Set
     )  is new Ada.Finalization.Limited_Controlled with private;

This is a helper type used to ensure that each Seize_All is matched by a Release_All even if an exception is propagated. It is used as follows:

   Resources : aliased Mutexes_Array; -- Resources
  
...
begin
   ...
   declare
      Mutexes : aliased Mutexes_Set := ...; -- The resources we need here
      Lock    : Set_Holder (Resource'Access, Mutexes'Access); -- Seize them
   begin
      ...  -- Enjoy exclusive access
   end  -- Release the resources

type Singleton_Holder
     (  Resource : access Mutexes_Array;
        Seize    : Mutex_Type
     )  is new Ada.Finalization.Limited_Controlled with private;

This is a helper type used to ensure that each Seize is matched by a Release even if an exception is propagated. It is used as follows:

   Resources : aliased Mutexes_Array; -- Resources
  
...
begin
   ...
   declare
      Lock : Singleton_Holder (Resource'Access, Mutex); -- Seize Mutex
   begin
      ...  -- Enjoy exclusive access
   end  -- Release the resources

It is strongly recommended to use a Holder object in order to access a mutex even if that might cause some overhead. The reason is that asynchronous transfer of control (Language Reference Manual 9.7.4)) from a task owning a mutex might leave the mutex seized. A Holder object warranties mutex release. In general one should avoid asynchronous transfer of control.

11.3.3. Dining philosophers sample

The following example illustrates use of mutexes array. It represents a solution of the Dining Philosophers problem. The problem is exposed when Pi processes are competing for Ri resources, i=1..N, accessing more than one resource at a time. Philosophers are tasks. Each philosopher spends some random time thinking. Then he enters the dining room and takes his seat at the round table. In order to start to eat he seizes two forks, one on the left and another on the right of him. A philosopher waits for forks to become free if other philosophers use them. He puts both forks down and leaves the room when finished. The cycle repeats so long the philosopher lives. A deadlock occurs when, all philosophers seize a fork on their left. When the cutlery is implemented as an array of mutexes, where each fork is a mutex, no deadlock is possible, which solves the problem:

File test_dining_philosophers_forks.ads:

with Synchronization.Generic_Mutexes_Array;

package Test_Dining_Philosophers_Forks is
   type 
Philosopher is (Aristotle, Kant, Spinoza, Marx, Russel);
   package Forks is
      new
Synchronization.Generic_Mutexes_Array (Philosopher);
end Test_Dining_Philosophers_Forks;

This package instantiates Synchronization.Generic_Mutexes_Array, which is necessary to do at the library level in Ada 95. In Ada 2005 it can be instantiated in nested scopes. The type Philosopher identifies the philosophers as well as the the fork on the right of the corresponding philosopher's seat.

File test_dining_philosophers.adb:
with Ada.Exceptions;             use Ada.Exceptions;
with Ada.Numerics.Float_Random;  use Ada.Numerics.Float_Random;
with Ada.Text_IO;                use Ada.Text_IO;

with Test_Dining_Philosophers_Forks;
use  Test_Dining_Philosophers_Forks;

procedure Test_Dining_Philosophers is
   use
Test_Dining_Philosophers_Forks.Forks;

   Forks : aliased Mutexes_Array; -- Forks for hungry philosophers
   --
   -- Left_Of -- The fork left to the given one
   --
   function Left_Of (Fork : Philosopher) return Philosopher is
   begin
      if
Fork = Philosopher'First then
         return
Philosopher'Last;
      else
         return
Philosopher'Pred (Fork);
      end if;
   end Left_Of;
   --
   -- Person -- A task running some philosopher
   --
   -- ID - The philosopher ID
   --

   task type Person (ID : Philosopher);
   task body Person is
      Cutlery : aliased Mutexes_Set := ID or Left_Of (ID);
      Dice    : Generator;
   begin
      Reset (Dice);
      for Life_Cycle in 1..50 loop
         -- In his life a philosopher eats 50 times
         Put_Line (Philosopher'Image (ID) & " is thinking");
         delay Duration (Random (Dice) * 0.100);
         Put_Line (Philosopher'Image (ID) & " is hungry");
         declare
            Lock : Set_Holder (Forks'Access, Cutlery'Access);
         begin
            Put_Line (Philosopher'Image (ID) & " is eating");
            delay Duration (Random (Dice) * 0.100);
         end;
      end loop;
      Put_Line (Philosopher'Image (ID) & " is leaving");
   exception
      when
Error: others =>
         Put_Line
         (  Philosopher'Image (ID)
         &  " caused "
         &  Exception_Information (Error)
         );
   end Person;

   T1 : Person (Aristotle); -- Start philosophers
   T2 : Person (Kant);
   T3 : Person (Spinoza);
   T4 : Person (Marx);
   T5 : Person (Russel);
begin
   null
; -- Nothing to do in the main task, just sit and behold
end Test_Dining_Philosophers;

In this implementation a philosopher seizes his forks using Seize_All. Because this is an indivisible operation it cannot deadlock.


[Back][TOC][Next]

12. Inter-process communication

The package Synchronization.Interprocess and its children provide means for communication between separate processes in a portable way. The following synchronization primitives and object are supported:

Synchronization is performed through an environment object derived from the type Abstract_Shared_Environment:

type Abstract_Shared_Environment is abstract
   new
Ada.Finalization.Limited_Controlled with private;

The environment represents a system-wide object shared by all processes. Each process must have an instance of the environment. The first process creates environment under a system-wide name. The following processes connect to the environment using this name. The object implementing individual synchronization primitives are placed into the environment object as record members. For example:

type Shared_Data is
   new
Abstract_Shared_Environment with
record

   Not_Full_Event  : Event;
   Not_Empty_Event : Event;
   Queue           : Shared_Integer_Queue.FIFO_In (1_000);
end record;

All processes must have matching number and types of the components in the environment. The environment enumerates its members and initializes in order necessary to function upon a call to Create or Open:

procedure Create
          (  Shared : in out Abstract_Shared_Environment;
             Name   : String
          );

This procedure is called by the first process which serves as a master of all following processes. When the master process finalizes its environment all slave processes can still use it for communication between them, but no new slaves can connect. The parameter Name must contain a unique system-wide name. Depending on the operating system, it further can be required to be a legal simple file name. The members of the environment may impose restrictions on which other member must appear within the structure. If these restrictions are not met Mode_Error is propagated.

Exceptions
Data_Error I/O errors
Mode_Error Invalid configuration of the environment
Name_Error Invalid name
Status_Error The environment is already open
Use_Error A system object with this name already exists

procedure Close (Shared : in out Abstract_Shared_Environment);

This procedure is void if the system automatically collects the shared environment resource. Under an OS like Linux it is be used to ensure that the resource, e.g. a file, is deleted upon abnormal completion of the program. The effect of a call to close can be that no more processes will be able join using the environment. Status_Error is propagated when the environment is not open.

procedure Open
          (  Shared : in out Abstract_Shared_Environment;
             Name   : String;
             Create : Boolean := False
          );

This procedure is called by any slave process which wants to connect to the master. A slave process may finalize its environment at any time. The parameter Name must be the name used in Create. When Create is true the environment is create when does not exist. The members of the environment must match ones of the master, otherwise Data_Error is propagated.

Exceptions
Data_Error I/O errors, the configuration does not match one of the master
Mode_Error Invalid configuration of the environment
Name_Error Invalid name
Status_Error The environment is already open
Use_Error A system object with this name does not exists, only if Create is false

Other primitive operations of Abstract_Shared_Environment are:

procedure Finalize (Shared : in out Abstract_Shared_Environment);

This procedure must be called by the derived type if it overrides it. When the process that created environment destroys the object no more processes can connect to it. The processes already connected may continue using it. The environment is ultimately destroyed when the last process destroys its object.

function Get_Size
         (  Shared : Abstract_Shared_Environment
         )  return Storage_Count;

This function returns the amount of shared memory used by the environment. Usually the environment uses a memory mapping to keep shared data. The minimal size of this mapping is returned by this function. Status_Error is propagated when the environment is not created or open.

procedure Initialize (Shared : in out Abstract_Shared_Environment);

This procedure must be called by the derived type if it overrides it. The environment object becomes first usable after either Create or Open is called.

function Get_Size
         (  Shared : Abstract_Shared_Environment
         )  return Storage_Count;

This function returns the amount of shared memory used by the environment. Usually the environment uses a memory mapping to keep shared data. The minimal size of this mapping is returned by this function.

[Back][TOC][Next]

12.1. Inter-process synchronization objects

All inter-process synchronization objects are either descendants or contain descendants of the base type Abstract_Shared_Object defined in the package Synchronization.Interprocess:

type Abstract_Shared_Object is abstract
   new
Ada.Finalization.Limited_Controlled with private;

The following abstract primitive operations must be implemented by a derived type:

function Get_Offset
         (  Object : Abstract_Shared_Object
         )  return Storage_Offset;

This function returns the offset to the object data in the shared memory. It is set by the procedure Map when the object's data are first allocated in the shared memory.

function Get_Signature
         (  Object : Abstract_Shared_Object
         )  return Unsigned_16;

This function returns the signature used to verify if the shared environment contains same objects in all instances. The default implementation uses the external tag name with the function Get_Signature also provided by the package:

function Get_Signature (Data : String) return Unsigned_16;

e.g. using External_Tag (X'Tag) as the argument.

function Get_Size
         (  Object : Abstract_Shared_Object
         )  return Storage_Count is abstract;

This function returns the amount of shared memory in the environment required by the object.

procedure Map
          (  Object   : in out Abstract_Shared_Object;
             Shared   : in out Abstract_Shared_Environment'Class;
             Location : System.Address;
             Size     : Storage_Count;
             Owner    : Boolean
          )  is abstract;

This procedure is called once upon mapping the shared memory. The parameter Owner is true when the current process is the master process that has created the memory map. Thus if the shared object requires an initialization done once, this is a hint when to perform the initialization. After returning from Map the object must become fully operational. The parameter Shared is the shared environment containing the object. The parameter Location is the address in the shared memory allocated for the object. Size is the amount of the shared memory. It has the value previously obtained from Get_Size.

procedure Start
          (  Object : in out Abstract_Shared_Object;
             Shared : in out Abstract_Shared_Environment'Class;
             Owner  : Boolean
          );

This procedure is called once upon mapping the shared memory after calling Map for all object. The implementation can consider all objects initialized. It is a point when a worker task can be started. The default implementation does nothing.

procedure Unmap
          (  Object : in out Abstract_Shared_Object;
             Shared : in out Abstract_Shared_Environment'Class;
             Owner  : Boolean
          );

This procedure is reverse to Map. It is called before finalization in order to perform cleanup. The default implementation does nothing.

Memory-mapper package. The package Synchronization.Interprocess also provides a helper generic package to map shared memory in the object:

generic
   type
Object_Type is limited private;
package Generic_Memory_Mapper is
   type
Object_Type_Ptr is access all Object_Type;
   function Map
            (  Location : System.Address;
               Owner    : Boolean
            )  return Object_Type_Ptr;
end Generic_Memory_Mapper;

[Back][TOC][Next]

12.2. Events

The package Synchronization.Interprocess.Events provides manual-reset events:

type Event is new Abstract_Shared_Object with private;

An event can be signaled and reset. The event can be awaited by any task of any process. Any task of any process can signal or reset it. The following primitive operations are defined:

function Is_Signaled (Object : Event) return Boolean;

This function returns true if the event Object is signaled. Data_Error is propagated on system errors. Status_Error is propagated when the object is not initialized.

procedure Reset (Object : in out Event);

This procedure resets the event if it is signaled. Data_Error is propagated on system errors. Status_Error is propagated when the object is not initialized.

procedure Signal (Object : in out Event);

This procedure signals the event if it is not signaled. Data_Error is propagated on system errors. Status_Error is propagated when the object is not initialized.

procedure Wait
          (  Object  : in out Event;
             Timeout : Duration := Duration'Last
          );
procedure Wait
          (  Object   : in out Event;
             Timeout  : Duration;
             Signaled : out Boolean
          );

This procedure awaits the event. The variant with Signaled parameter does not propagate Timeout_Error. Instead of that Signaled is set true when the event was signaled and false when the timeout expired.

Exceptions
Data_Error System errors
Status_Error The event is not initialized
Timeout_Error The timeout has been expired before the event was signaled (the variant without Signaled parameter)

[Back][TOC][Next]

12.3. Pulse events

The package Synchronization.Interprocess.Pulse_Events provides pulse events:

type Pulse_Event is new Abstract_Shared_Object with private;

An event can be pulsed to release all tasks awaiting it. The following primitive operations are defined:

procedure Pulse (Object : in out Pulse_Event);

This procedure pulses the event. Data_Error is propagated on system errors. Status_Error is propagated when the object is not initialized.

procedure Wait
          (  Object  : in out Pulse_Event;
             Timeout : Duration := Duration'Last
          );
procedure Wait
          (  Object   : in out Pulse_Event;
             Timeout  : Duration;
             Signaled : out Boolean
          );

This procedure awaits the event. The variant with Signaled parameter does not propagate Timeout_Error. Instead of that Signaled is set true when the event was signaled and false when the timeout expired.

Exceptions
Data_Error System errors
Status_Error The event is not initialized
Timeout_Error The timeout has been expired before the event was signaled (the variant without Signaled parameter)

[Back][TOC][Next]

12.4. Mutexes

The package Synchronization.Interprocess.Mutexes provides re-entrant mutexes:

type Mutex is new Abstract_Shared_Object with private;

Only one task may hold the mutex. All other tasks trying to seize it await the mutex to be released. The mutex is re-entrant, so the same task may seize it multiple times. If a task seizes the mutex n times, it must release it also n times. The following primitive operations are defined:

function Get_Timeout (Object : Mutex) return Duration;

This function returns the default timeout used when a task awaits the mutex. See Set_Timeout.

procedure Grab (Object : in out Mutex);

This procedure attempts to seize the mutex without waiting. It returns immediately and then the mutex state can be tested using Is_Mine function:

Grab (Resource);       -- Try to seize it without blocking
if Is_Mine (Resource) then
   ...                 -- Use the resource
   Release (Resource); -- Note, it has to be released
end if;

Data_Error is propagated on system errors. Status_Error is propagated when the mutex is not initialized.

function Is_Mine (Object : Mutex) return Boolean;

This function returns true if the mutex is owned by the current task. Data_Error is propagated on system errors. Status_Error is propagated when the mutex is not initialized.

function Is_Owned (Object : Mutex) return Boolean;

This function returns true if the mutex is owned by any task. Data_Error is propagated on system errors. Status_Error is propagated when the mutex is not initialized.

procedure Release (Object : in out Mutex);

This procedure releases the mutex owned by the current task. The mutex becomes free if all calls to Seize are matched by a call to Release.

Exceptions
Data_Error System errors
Ownership_Error The mutex is not owned by the task
Status_Error The object is not initialized

procedure Seize (Object : in out Mutex);
procedure Seize (Object : in out Mutex; Timeout : Duration);

This procedure seizes the mutex. Seize does not block when the task already owns the mutex. Each call to Seize shall be matched by a call to Release. When the mutex is owned by another task the procedure waits either specified time or else the default set by Set_Timeout.

Exceptions
Data_Error System errors
Status_Error The object is not initialized
Timeout_Error The procedure timed out

procedure Set_Timeout
          (  Object  : in out Mutex;
             Timeout : Duration
          );

This procedure sets the default wait timeout.

The package also defines a helper type to ease mutex usage:

type Holder (Resource : access Mutex) is
   new
Ada.Finalization.Limited_Controlled with private;

The initialization seizes the mutex and finalization releases it. For example:

declare
   Lock : Holder (Resource'Access);
begin
   ... -- Use the resource safely
end;

[Back][TOC][Next]

12.5. Shared objects

The generic package Synchronization.Interprocess.Generic_Shared_Object provides shared values which can be loaded and stored safely:

generic
   type
Object_Type is private;
package Synchronization.Interprocess.Generic_Shared_Object is ...

The generic formal parameter Object_Type is the type of the value. Note that it cannot be controlled or contain controlled components. Though it can have initialized values. The initialization will be performed when the containing environment is initialized by the master process. The shared object type is:

type Shared_Object is new Abstract_Shared_Object with private;

The shared object requires a mutex for interlocking. The mutex object must be placed in the shared environment object before the shared object. For example:

type Shared is new Abstract_Shared_Environment with record
  
Lock : Mutex;
   Data : Shared_Object; -- Uses the mutex above
end record
;

The mutex can be shared by several object. Without the mutex creating or opening the shared environment will propagate Data_Error. The following primitive operations are defined on shared objects:

function Get (Object : Shared_Object) return Object_Type;

This function returns the shared object's value. Data_Error is propagated on system errors. Status_Error is propagated when the object is not initialized.

procedure Set
          (  Object : in out Shared_Object;
             Value  : Object_Type
          );

This procedure sets the new value. Data_Error is propagated on system errors. Status_Error is propagated when the object is not initialized.

The package also defines a generic procedure allowing accessing the object concurrently:

generic
   with procedure
Operation (Value : in out Object_Type);
procedure
Generic_Call (Object : in out Shared_Object);

Execution of the procedure is equivalent to seizing the object's mutex, calling Operation and then releasing the mutex.

[Back][TOC][Next]

12.6. FIFO, first-in, first-out queue

The generic package Synchronization.Interprocess.Generic_FIFO provides shared first-in first-out queue:

generic
   type
Element_Type is private;
package Synchronization.Interprocess.Generic_FIFO is ...

The generic formal parameter Element_Type is the type of the queue elements. Note that it cannot be controlled or contain controlled components because the instances are shared between processes accessing the FIFO. The FIFO has two ends, the input end at which new elements are placed and the output end where elements are taken from. For each FIFO end there is a separate object type derived from the base FIFO type:

type FIFO (Size : Positive) is abstract
   new
Abstract_Shared_Object with private;

The discriminant Size is the maximum number of elements the queue can hold - 1. The queue requires two events. The events must be placed in front of the queue. For example:

type Shared_Data is
   new
Abstract_Shared_Environment with
record

   Not_Full_Event  : Event;
   Not_Empty_Event : Event;
   Queue           : FIFO_In (1_000);
end record;

When more than two events precede the queue, the last two are used. Without the events creating or opening the shared environment will propagate Data_Error. The following primitive operations are provided by the type:

function Is_Empty (Queue : FIFO) return Boolean;

This function returns true if the queue is empty. Status_Error is propagated when the object is not initialized.

function Is_Full (Queue : FIFO) return Boolean;

This function returns true if the queue is full. Status_Error is propagated when the object is not initialized.

function Is_Preserved
         (  Queue   : FIFO;
            Element : Element_Type
         )  return Boolean;

The function is used by Purge to determine which elements to preserve in the queue. The default implementation returns true.

procedure Wait_For_Not_Empty
          (  Queue   : in out FIFO;
             Timeout : Duration;
           [ Empty   : out Boolean ]
          );

This procedure awaits for some elements in the queue. The procedure waits for the specified timeout. When the timeout expires Timeout_Error is propagated when the parameter Empty is absent. With the parameter Empty no exception is propagated and Empty is set to true. When the queue becomes not empty before timeout expiration Empty is set to false. This procedure must be interlocked with taking elements from the queue. Status_Error is propagated when the object is not initialized.

procedure Wait_For_Not_Full
          (  Queue   : in out FIFO;
             Timeout : Duration;
           [ Full    : out Boolean ]
          );

This procedure awaits for free space in the queue. The procedure waits for the specified timeout. When the timeout expires Timeout_Error is propagated when the parameter Full is absent. With the parameter Full no exception is propagated and Full is set to true. When the queue becomes not full before timeout expiration Full is set to false. This procedure must be interlocked with putting elements into the queue. Status_Error is propagated when the object is not initialized.

Exclusive in-end:

type FIFO_In is new FIFO with private;

The type FIFO_In is used for the exclusive input end of the queue. Only one process can hold this end, otherwise Mode_Error is propagated when the environment is opened. The following primitive operation is defined on FIFO_In:

procedure Put
          (  Queue   : in out FIFO_In;
             Element : Element_Type;
             Timeout : Duration := Duration'Last
          );

The procedure places Element into Queue. When there is no place in the queue it blocks until either an element will be taken from the queue or the specified timeout expires.

Exceptions
Data_Error System errors
Status_Error The object is not initialized
Timeout_Error The procedure timed out

Multiplexed in-end:

type FIFO_Multiplexed_In is new FIFO with private;

The type FIFO_Multiplexed_In can be used by more than one process, when the queue must be written concurrently. It cannot be mixed with exclusive FIFO_In, otherwise Mode_Error is propagated when the environment is opened. It also requires a mutex object for interlocking, which must appear before the object else Data_Error is propagated. The following primitive operation is defined on FIFO_Multiplexed_In:

procedure Put
          (  Queue   : in out FIFO_Mutliplexed_In;
             Element : Element_Type;
             Timeout : Duration := Duration'Last
          );

The procedure places Element into Queue. When there is no place in the queue it blocks until either an element will be taken from the queue or the specified timeout expires.

Exceptions
Data_Error System errors
Status_Error The object is not initialized
Timeout_Error The procedure timed out

Exclusive out-end:

type FIFO_Out is new FIFO with private;

The type FIFO_Out is used for the exclusive output end of the queue. Only one process can hold this end, otherwise Mode_Error is propagated when the environment is opened. The following primitive operation is defined on FIFO_Out:

procedure Delete
          (  Queue   : in out FIFO_Out;
             Count   : Natural  := 1;
             Timeout : Duration := Duration'Last
          );

The procedure removes the specified number of elements from Queue. When Count is greater than the current queue length, all elements are removed. The procedure does not wait for new elements, it deletes the element available. Timeout_Error is propagated only if access to the queue is blocked.

Exceptions
Data_Error System errors
Status_Error The object is not initialized
Timeout_Error The procedure timed out because the queue is blocked by an FIFO_Multiplexed_In

function Get
         (  Queue   : FIFO_Out;
            Timeout : Duration := Duration'Last
         )  return Element_Type;

The function takes one element from the queue. It blocks when the queue is empty.

Exceptions
Data_Error System errors
Status_Error The object is not initialized
Timeout_Error Timeout

procedure Peek
          (  Queue   : in out FIFO_Out;
             Element : out Element_Type;
             Empty   : out Boolean;
             Timeout : Duration := Duration'Last
          );

The procedure returns an element leaving it in the queue. Empty is set to true if the queue is empty and Element is not set. The operation does not  block unless FIFO_Multiplexed_In is used. Timeout_Error is propagated only if access to the queue is blocked.

Exceptions
Data_Error System errors
Status_Error The object is not initialized
Timeout_Error The procedure timed out because the queue is blocked by an FIFO_Multiplexed_In

procedure Purge
          (  Queue   : in out FIFO_Out;
             Purged  : out Natural;
             Timeout : Duration := Duration'Last
          );

This procedure removes the queue elements for which the function Is_Preserved returned false. The parameter Purged is set to the number of elements removed from the queue. The procedure does not block, Timeout_Error is propagated only if access to the queue is blocked.

Exceptions
Data_Error System errors
Status_Error The object is not initialized
Timeout_Error The procedure timed out because the queue is blocked by an FIFO_Multiplexed_In

procedure Purge
          (  Queue        : in out FIFO_Out;
             Is_Preserved : Is_Preserved_Ptr;
             Purged
       : out Natural;
             Timeout      : Duration := Duration'Last
          );

This is a variant of Purge with the criterion of removal is passed as a function in the parameter Is_Preserved. It has the following signature:

type Is_Preserved_Ptr is access
   function
(Element : Element_Type) return Boolean;

Universal end:

type FIFO_End is (In_End, Multiplexed_In_End, Out_End);
type
Universal_FIFO is new FIFO with private;

Objects of this type may serve as any end. The requires a mutex object for interlocking, which must appear before the object otherwise Data_Error is propagated. The end type is maintained by the following primitive operations:

function Get_Mode (Queue : Universal_FIFO) return FIFO_End;

This function returns the type of the queue's end.

procedure Set_Mode (Queue : in out Universal_FIFO; Mode : FIFO_End);

This procedure sets the type of the queue end. It must be called before creating or opening the shared environment object containing the queue object. Otherwise Mode_Error is propagated.

[Back][TOC][Next]

12.7. Inter-process streams

The package Synchronization.Interprocess.Streams provides streams with the ends located in different processes:

type Interprocess_Stream (Size : Stream_Element_Count) is
   abstract new
Root_Stream_Type with private;

The discriminant Size is the maximum number of stream elements the queue can hold - 1. The type is abstract, the stream ends are its descendants. The stream requires two events. The events must be placed in front of the stream object. For example:

type Shared_Data is
   new
Abstract_Shared_Environment with
record

   Not_Full_Event  : Event;
   Not_Empty_Event : Event;
   Stream          : Input_Stream (1_000);
end record;

When more than two events precede the stream, the last two are used. Without the events creating or opening the shared environment will propagate Data_Error. Reading from and writing into the stream block until all required stream elements are read or written or the timeout is expired. The following primitive operations are provided by the base type:

procedure Close (Stream : in out Interprocess_Stream);

This procedure sets the stream closed. When closed reading from the stream does not block, but returns available elements. Writing into a closed stream results in End_Error propagation. When reading from an empty stream End_Error is propagated. The stream can be re-opened again using Open. Status_Error is propagated when the object is not initialized.

function End_Of_Stream (Stream : Interprocess_Stream) return Boolean;

This function returns true is the stream is empty and closed. The stream end is set by calling the procedure Close or when an end is finalized. This is a way to stop reading from the stream at the writer side when the reader has no information when to stop. Status_Error is propagated when the object is not initialized.

function Get_Offset
         (  Stream : Interprocess_Stream
         )  return Storage_Offset is abstract;

This function returns the offset to the stream data in the shared memory. It is set by the procedure Map when the data are first allocated in the shared memory.

function Get_Timeout (Stream : Interprocess_Stream) return Duration;

This function returns the timeout used for stream I/O operations.

function Is_Closed (Stream : Interprocess_Stream) return Boolean;

This function returns true is the stream is closed. Status_Error is propagated when the object is not initialized.

function Is_Empty (Stream : Interprocess_Stream) return Boolean;

This function returns true is the stream buffer is empty. Status_Error is propagated when the object is not initialized.

function Is_Full (Stream : Interprocess_Stream) return Boolean;

This function returns true is the stream buffer is full. Status_Error is propagated when the object is not initialized.

procedure Open (Stream : in out Interprocess_Stream);

This procedure re-opens previously closed stream. Status_Error is propagated when the object is not initialized.

procedure Set_Timeout
          (  Stream  : in out Interprocess_Stream;
             Timeout : Duration
          );

This procedure sets the timeout used for stream I/O operations. Note that the timeout is specific to the process. Different instances can have different timeouts set.

procedure Skip
          (  Stream  : in out Output_Stream;
             Count   : in out Stream_Element_Count;
           [ Timeout : Duration ]
          );

This procedure skips the specified number of elements in the stream. The procedure blocks until all elements are skipped or the timeout expires. The timeout is specified by the parameter Timeout. When omitted the timeout set by Set_Timeout is used. When the stream is closed the procedure ends immediately. The parameter Count is always decreased by the number of actually skipped elements.

Exceptions
End_Error The stream is empty and closed
Status_Error The object is not initialized

procedure Wait_For_Not_Empty
          (  Stream  : in out Interprocess_Stream;
             Timeout : Duration;
           [ Empty   : out Boolean ]
          );

This procedure awaits for some data in the stream. The procedure waits for the specified timeout. When the timeout expires Timeout_Error is propagated when the parameter Empty is absent. With the parameter Empty no exception is propagated and Empty is set to true. When the stream becomes not empty before timeout expiration Empty is set to false. This procedure must be interlocked with reading from the stream.

Exceptions
End_Error The stream is empty and closed
Status_Error The object is not initialized

procedure Wait_For_Not_Full
          (  Stream  : in out Interprocess_Stream;
             Timeout : Duration;
           [ Full    : out Boolean ]
          );

This procedure awaits for free space in the stream. The procedure waits for the specified timeout. When the timeout expires Timeout_Error is propagated when the parameter Full is absent. With the parameter Full no exception is propagated and Full is set to true. When the stream becomes not full before timeout expiration Full is set to false. This procedure must be interlocked with writing into the stream.

Exceptions
End_Error The stream is full and closed
Status_Error The object is not initialized

Stream's input end:

type Input_Stream is new Interprocess_Stream with private;

The type Input_Stream is used for the exclusive input end of the stream. Only one process can hold this end, otherwise Mode_Error is propagated when the environment is opened. Writing into Input_Stream propagates Mode_Error. When reading from Input_Stream the implementation blocks until all buffer is read or else the default timeout (see Set_Timeout) is expired. It also does not block when the output end of the stream was closed by Close. In both cases of premature completion the operation returns read elements and no Timeout_Error is propagated.

Exceptions
Data_Error System errors
Status_Error The object is not initialized

Stream's output end:

type Output_Stream is new Interprocess_Stream with private;

The type Output_Stream is used for the exclusive input end of the stream. Only one process can hold this end, otherwise Mode_Error is propagated when the environment is opened. Reading from Output_Stream or skipping its elements propagate Mode_Error. When writing into Output_Stream the implementation blocks until all buffer is written or else the default timeout (see Set_Timeout) is expired.

Exceptions
Data_Error System errors
Status_Error The object is not initialized
Timeout_Error The procedure timed out

Stream's universal end:

type Stream_End is
     (  In_End,
        Multiplexed_In_End,
        Out_End,
        Multiplexed_Out_End
     );
type Universal_Stream is new Interprocess_Stream with private;

The type Universal_Stream is used for either end. The end type can be set before the containing shared environment is created or opened:

function Get_Mode (Queue : Universal_Stream) return Stream_End;

This function returns the type of the stream's end.

procedure Set_Mode (Queue : in out Universal_Stream; Mode : Stream_End);

This procedure sets the type of the end. It must be called before creating or opening the shared environment object containing the queue object. Otherwise Mode_Error is propagated. The mode has the following meaning:

Note. The multiplexed stream ends act concurrently and therefore a mutex or some other synchronization method must be used to interlock concurrent multiplexed reading and writing. The Universal_Stream object does not deploy any mutex though. The reason is that stream operations can be split into individual stream reads and writes which makes interlocking at the level of individual reading and writing meaningless. Therefore if mutliplexed ends are used the application must interlock them.

[Back][TOC][Next]

12.8. Memory pools

The package Synchronization.Interprocess.Memory_Pools provides memory pools shared between different processes:

type Interprocess_Pool (Size : Pool_Storage_Count) is
   new
Root_Storage_Pool with private;

The discriminant Size is the maximum number of storage elements used for the pool. It is a subtype of Storage_Count. The pools requires a mutex object for interlocking. The mutex must be placed in front of the pool object, which itself must be placed in the shared environment. For example:

type Shared_Data is
   new
Abstract_Shared_Environment with
record

   Lock : Mutex;
   Pool : Interprocess_Pool (1_000);
end record;

The type implements the standard pool operations Allocate and Deallocate. Data_Error is propagated on system errors when dealing with the mutex. Timeout_Error is propagated when seizing the mutex is timed out. Status_Error is propagated when the pool was not initialized. Storage_Error is propagated when there is no place in the memory pool or when the address does not belong to the pool and in the case of pool corruption.

Note. The pool operations are interlocked, the operations on the objects allocated in the pool are not. Therefore when the objects are expected to be accessed concurrently this must be additionally interlocked.

Other primitive operations are:

function Get_Timeout (Stream : Interprocess_Pool) return Duration;

This function returns the timeout used for seizing the mutex.

procedure Get_Statistics
          (  Pool        : Interprocess_Pool;
             Free_Blocks : out Natural;
             Used_Blocks : out Natural;
             Free_Space  : out Storage_Count;
             Used_Space  : out Storage_Count
          );

This procedure returns current pool statistics. Free_Blocks is the number of free memory blocks in the pool. Used_Blocks is the number of allocated memory blocks. Free_Space is the space available in the free memory blocks. This does not include the margins of the blocks. Used_Space is the space used in the used memory blocks. This space does not include the block margins. Status_Error is propagated when the pool was not initialized.

function Get_Offset
         (  Pool : Interprocess_Pool
         )  return Storage_Offset;

This function returns the offset to the pool data in the shared memory. It is set by the procedure Map when the data are first allocated in the shared memory.

procedure Set_Timeout
          (  Stream  : in out Interprocess_Pool;
             Timeout : Duration
          );

This procedure sets the timeout used for seizing the mutex when allocating or deallocating memory pool.

System-wide references. When memory is allocated in the pool the returned address is specific to the current process. If the address must be passed to another process, the type Reference must be used:

type Reference is private;
Null_Reference : constant Reference;

The reference is a scalar type which can be passed between processes and stored in the inter-process shared memory.

Note. The address of an instance of indefinite array type is the address of the first array element. The consequence of that is that a reference to the array address is not a reference to the array. If an array need to be passed by a pool reference the address used in address to reference and back conversions must use the proper address of the array which is A'Address - size of the array bounds.

The following subprograms are used with references:

procedure Free
          (  Pool    : in out Interprocess_Pool;
             Pointer : in out Reference
          );

This procedure frees the memory block corresponding to the reference Pointer. After successful completion Pointer is set to Null_Reference. Status_Error is propagated when Pool was not initialized. Storage_Error is propagated when sanity checks of Pointer fail.

function To_Address
         (  Pool    : Interprocess_Pool;
            Pointer : Reference
         )  return System.Address;

This function returns the address corresponding to the reference Pointer. Status_Error is propagated when Pool was not initialized. Storage_Error is propagated when sanity checks of Pointer fail.

function To_Reference
         (  Pool    : Interprocess_Pool;
            Address : System.Address
         )  return Reference;

This function returns a reference corresponding to the address. Status_Error is propagated when Pool was not initialized. Storage_Error is propagated when sanity checks of Address fail.

[Back][TOC][Next]

12.9. Blackboard

The generic package Synchronization.Interprocess.Generic_Blackboard provides implementation of a blackboard shared between different processes:

generic
   type
Element_Type (<>) is private;
package Synchronization.Interprocess.Generic_Blackboard is ...

The formal parameter Element_Type is the type of object put onto the blackboard. The elements may not be controlled or contain controlled components because they are shared. The package defines the type of a blackboard as follows:

type Blackboard (Size : Storage_Count) is
   new
Abstract_Shared_Object with private;

The discriminant Size is the maximum number of storage elements used for the blackboard in the shared memory. The blackboard requires a mutex object for interlocking when elements are put onto it. The mutex must be placed in front of the blackboard object, which itself must be placed in the shared environment as well. For example:

type Shared_Data is
   new
Abstract_Shared_Environment with
record

   Lock  : Mutex;
   Board : Blackboard (1_000);
end record;

The elements on the blackboard are referenced using the type Reference declared as:

type Reference is private;

References can be moved around and passed between processes. Each element ever put onto the blackboard has a unique reference. A reference is valid until the element is on the blackboard. Once overridden by another element the reference becomes invalid. References are ordered according to the order in which elements were placed onto the blackboard. The following comparison operations are defined on references:

function "<"  (Left, Right : Reference) return Boolean;
function ">"  (Left, Right : Reference) return Boolean;
function "<=" (Left, Right : Reference) return Boolean;
function ">=" (Left, Right : Reference) return Boolean;

The lowest reference value corresponds to no element and is declared as a constant in the package:

First_Reference : constant Reference;

The following primitive operations are defined on Blackboard:

function First (Storage : Blackboard) return Reference;

This function returns a reference to the first (oldest) element on the blackboard. Note that this function can return an invalid reference when used concurrently. It that case the caller should call it again, unless the result is greater than Storage according to >. That would mean that the blackboard is empty. Status_Error is propagated when the blackboard is not initialized.

function Get (Storage : Blackboard; Pointer : Reference)
   return Element_Type;

This function returns the element pointed by the reference Pointer. It does not block. Constraint_Error is propagated when the reference is no longer valid. Status_Error is propagated when the blackboard is not initialized.

function Image (Pointer : Reference) return String;

This function returns a text representation of Pointer.

function Is_Valid (Storage : Blackboard; Pointer : Reference)
   return Boolean;

This function returns true if there is an element pointed by the reference Pointer. It does not block. Note that there is a race condition here, because the reference can become invalid before the called could use it. Status_Error is propagated when the blackboard is not initialized.

procedure Next
          (  Storage : Blackboard;
             Pointer : in out Reference;
             Sequent : out Boolean
          );

The procedure advances Pointer to the next (newer) element. When Pointer is valid and there is a next element then Sequent is set to true and Pointer will refer to that element. When Pointer refers to a lost element then it is set to the first available element and Sequent is set to false. When Pointer refers to a not yet available element, it is not changed and Sequent is set to true. The caller must beware the race condition. Status_Error is propagated when the blackboard is not initialized.

procedure Put
          (  Storage : in out Blackboard;
             Element : Element_Type;
           [ Pointer : out Reference; ]
             Timeout : Duration := Duration'Last
          );

These procedures put Element onto Storage and when the parameter Pointer is present return a reference to it. The operation overrides the most outdated elements on the blackboard making references to them invalid. It blocks only to gain exclusive access to the blackboard.

Exceptions
Data_Error System errors when dealing with the mutex
Status_Error The blackboard is not initialized
Storage_Error Element is too large to fit into
Timeout_Error The procedure timed out

procedure Put
          (  Storage  : in out Blackboard;
             Element  : Element_Type;
             Preserve : Reference;
           [ Pointer  : out Reference; ]
             Success  : out Boolean;
             Timeout  : Duration := Duration'Last
          );

These procedures are similar to Put except that they allow to prevent purging any elements starting with the one indicated by the reference Preserve. The parameter Success is set true when Element was put into the blackboard. It is false when putting Element there would require removing items references by Preserve.

Exceptions
Data_Error System errors when dealing with the mutex
Status_Error The blackboard is not initialized
Storage_Error Element is too large to fit into
Timeout_Error The procedure timed out

function Upper (Storage : Blackboard) return Reference;

This function returns the least upper bound of Storage. That is the reference to the element which will be put next onto. Status_Error is propagated when the blackboard is not initialized.

function "<" (Storage : Blackboard; Pointer : Reference)
   return Boolean;
function ">" (Storage : Blackboard; Pointer : Reference)
   return Boolean;
function "<" (Pointer : Reference; Storage : Blackboard)
   return Boolean;
function ">" (Pointer : Reference; Storage : Blackboard)
   return Boolean;

These functions compare the blackboard with a reference. The blackboard is less than a reference if the latter refer to a not yet written object. It is greater than a reference if the object is already lost (overwritten). Status_Error is propagated when the blackboard is not initialized.

[Back][TOC][Next]

12.10. Remote procedure call

The package Synchronization.Interprocess.Process_Call_Service provides implementation of remote procedure calls (RPC) from process to process. A remote procedure can be called in two ways:

The parameters and results are passed using inter-process streams. Each process has an instance of call service object that owns the stream to read incoming call requests and receive results from the callee. The stream is read by a server task:

call services

12.10.1. Call service

The package defines the type of a call service:

type Call_Service
     (  Request_Queue_Size   : Positive;
        Request_Stream_Size  : Stream_Element_Count;
        Response_Stream_Size : Stream_Element_Count
     )  is new Abstract_Shared_Object with private;
type Call_Service_Ptr is access all Call_Service'Class;

The discriminants are:

type Call_Service_ID is new Interfaces.Unsigned_32;
Null_Call_Service_ID : constant := 0;
function Image (ID : Call_Service_ID) return String;

A value of Call_Service_ID uniquely identifies a call service in the same sharing environment. The following primitive operations are defined on Call_Service:

function Get_ID (Service : Call_Service) return Call_Service_ID;

This function returns the identifier of the argument Service. Status_Error is propagated when the call service is not initialized.

function Get_Process_ID (Service : Call_Service) return Process_ID;

This function returns the OS-dependent identification of the process servicing the calls of the argument Service. The result is Null_Process when the service is not yet active. Status_Error is propagated when the call service is not initialized.

function Is_Server (Service : Call_Service) return Boolean;

This function returns true if Sevice runs in the server mode. The server call service accepts incoming remote procedure calls and executes called methods. Status_Error is propagated when the call service is not initialized.

procedure On_Start (Service : in out Call_Service);

This procedure is called when the service task starts. The default implementation does nothing.

procedure Set_Server (Service : in out Call_Service);

This procedure sets the mode to the server mode. Only one process may run a service in the server mode and only one service can run in the server mode per sharing environment. This procedure must be called before creating or opening the sharing environment containing it.

type Sequence_No is new Unsigned_64;

A value of this type is used to identify remote call requests. It is a unique number for each request issued by a caller.

12.10.2. Methods

The package defines the abstract base type for remote call service methods:

type Abstract_Method is abstract
   new
Abstract_Shared_Object with private;

The types derived from Abstract_Method implements a remote subprogram. Instances of these must be placed into sharing environment in from of the first Call_Service instance. Upon creating or opening the sharing environment the methods are enumerated and attached to the call services. Each method is present on each process and can be called from each process. If the implementation must differentiate its behavior depending the process it can use Call_Service_ID for this.

type Method_ID is new Interfaces.Unsigned_32;
Null_Method_ID : constant := 0;
function Image (ID : Method_ID) return String;

A value of Method_ID uniquely identifies a remote subprogram in the same sharing environment. A combination Method_ID and Call_Service_ID identifies the method and the process where it must be called.

The following primitive operations are defined on Abstract_Method:

procedure Execute
          (  Method     : in out Abstract_Method;
             Parameters : in out Root_Stream_Type'Class;
             Results    : in out Root_Stream_Type'Class;
             Caller     : in out Call_Service'Class;
             No         : Sequence_No
          )  is abstract;

This procedure is called by the call service in response to an incoming remote procedure call. The implementation must read all parameters from the stream Parameters, execute its body, and finally write all results into the stream Results. The parameter Caller is the call service of the caller. The results stream must be written completely. If execution of the body must fail, it does not write any results and propagates an exceptions instead. The exception is then sent back to  the caller of the method.

function Get_ID (Method : Abstract_Method) return Method_ID;

This function returns the identifier of the remote subprogram Method. Status_Error is propagated when the method is not initialized.

function Get_Service
         (  Method : Abstract_Method;
          [ ID ]   : Call_Service_ID
         )  return Call_Service_Ptr;

This function returns a pointer to Call_Service by its identifier ID. Without the parameter ID a pointer to the Call_Service used by the process to handle the incoming call is returned. Constraint_Error is propagated when ID does not identify any call service. Status_Error is propagated when the method is not initialized.

function Get_Service_ID (Method : Abstract_Method)
   return Call_Service_ID;

This function returns the identifier of the Call_Service used by the process to handle the incoming call. Status_Error is propagated when the method is not initialized.

function Is_Synchronous (Method : Abstract_Method) return Boolean;

Normally the server executes remote calls synchronously. It calls Execute which reads the parameters and then writes the results. For this type of execution Is_Synchronous must return true, which is the default implementation. Sometimes it necessary to execute the method asynchronously to the service, for example, in order to perform a blocking or lengthy operation. In such cases Execute reads the parameters initiates the operation and then exits. To indicate this Is_Synchronous must return false. The remote caller will remain blocked and the service will take another call to process. The execution of the method continues asynchronously. Upon completion an instance of Generic_Complete is called, possibly from a task different from the service. Note that Is_Synchronous has only effect on synchronous remote calls.

generic
   with procedure
Complete
                  (  Method  : in out Abstract_Method'Class;
                     Results : in out Root_Stream_Type'Class;
                     Caller  : in out Call_Service'Class;
                     No      : Sequence_No
                  );
procedure
Generic_Complete
          (  Method : in out Abstract_Method'Class;
             Caller : in out Call_Service'Class;
             No     : Sequence_No
          );

This generic procedure is function is used to complete an asynchronously executed method. The formal generic parameter is the procedure that is called to write the results of the execution. The parameter Method specifies the method. The parameter Results is the stream used to write the results. The parameter Caller is the Call_Service called the method. It must be the same as the one passed to Execute. The parameter No is call's sequence number, which must the one passed to Execute. The procedure can raise an exception before writing the results in order to pass the exception to the caller.

12.10.3. Generic calls

generic
   type
Result_Type (<>) is private;
   with procedure Send_Parameters
                  (  Stream : in out Root_Stream_Type'Class
                  )  is <>;
function Generic_Function_Call
         (  Method  : Abstract_Method'Class;
            Callee  : Call_Service'Class;
            Timeout : Duration := Duration'Last
         )  return Result_Type;

This generic function is used to call a remote method. The formal generic parameters are:

The parameter Method specifies the remote function. The parameter Callee is the Call_Service to call the function at. Timeout is the timeout.

Exceptions
Status_Error The method or call service is not initialized
Timeout_Error The call is timed out
Use_Error The caller and the callee Call_Services are the same or the method is not handled by this Call_Service.

generic
   with procedure Send_Parameters
                  (  Stream : in out Root_Stream_Type'Class
                  )  is <>;
procedure Generic_Post
          (  Method  : Abstract_Method'Class;
             Callee  : Call_Service'Class;
             Timeout : Duration := Duration'Last
          );

This generic procedure is used to call a remote method asynchronously. The formal generic parameter is:

The parameter Method specifies the remote procedure. The parameter Callee is the Call_Service to call the procedure at. Timeout is the timeout.

Exceptions
Status_Error The method or call service is not initialized
Timeout_Error The call is timed out
Use_Error The caller and the callee Call_Services are the same or the method is not handled by this Call_Service

generic
   with procedure
Receive_Results
                  (  Stream : in out Root_Stream_Type'Class
                  )  is <>;
   with procedure Send_Parameters
                  (  Stream : in out Root_Stream_Type'Class
                  )  is <>;
procedure Generic_Procedure_Call
          (  Method  : Abstract_Method'Class;
             Callee  : Call_Service'Class;
             Timeout : Duration := Duration'Last
          );

This generic procedure is used to call a remote method. The formal generic parameters are:

The parameter Method specifies the remote procedure. The parameter Callee is the Call_Service to call the procedure at. Timeout is the timeout.

Exceptions
Status_Error The method or call service is not initialized
Timeout_Error The call is timed out
Use_Error The caller and the callee Call_Services are the same or the method is not handled by this Call_Service
other An exception propagated at the callee side

[Back][TOC][Next]

12.11. Convenience remote call packages

The following packages provide convenience remote procedure calls with parameters and results marshaled

12.11.1. Parameterless procedures

The convenience child package Synchronization.Interprocess.Process_Call_Service.Parameterless_Procedure provides an implementation of parameterless synchronous and asynchronous methods. The method at the callee's side is implemented by a parameterless procedure defined as:

type Implementation is access procedure
    
Callee : in out Call_Service'Class;
        Caller : in out Call_Service'Class
     );

It has the parameters Callee and Caller identifying two ends of the call.

type Asynchronous_Procedure is new Abstract_Method with private;

The type Asynchronous_Procedure is an implementation of asynchronously called parameterless procedures with the following primitive operations:

procedure Call
          (  Method  : Asynchronous_Procedure;
             Callee  : Call_Service'Class / Call_Service_ID;
             Timeout : Duration := Duration'Last
          );

This procedure performs asynchronous remote call to Method on Callee.

Exceptions
Status_Error The method or call service is not initialized
Timeout_Error The call is timed out
Use_Error The caller and the callee Call_Services are the same or the method is not handled by this Call_Service

procedure Set
          (  Method  : in out Asynchronous_Procedure;
             Handler : Implementation
          );

This procedure must be called on the callee's side to set the implementation of the procedure. Each process can have its own implementation.

type Synchronous_Procedure is new Abstract_Method with private;

The type Synchronous_Procedure is an implementation of synchronously called parameterless procedures with the following primitive operations:

procedure Call
          (  Method  : Synchronous_Procedure;
             Callee  : Call_Service'Class / Call_Service_ID;
             Timeout : Duration := Duration'Last
          );

This procedure performs synchronous remote call to Method on Callee.

Exceptions
Program_Error Not implemented (the implementation is not set)
Status_Error The method or call service is not initialized
Timeout_Error The call is timed out
Use_Error The caller and the callee Call_Services are the same or the method is not handled by this Call_Service
other An exception propagated at the callee side

procedure Set
          (  Method  : in out Synchronous_Procedure;
             Handler : Implementation
          );

This procedure must be called on the callee's side to set the implementation of the procedure. Each process can have its own implementation.

12.11.2. Parameterless generic functions

The convenience generic child package Synchronization.Interprocess.Process_Call_Service.Generic_Parameterless_Function provides an implementation of parameterless functions:

generic
   type
Result_Type (<>) is private;
package
Synchronization.Interprocess.Process_Call_Service.
        Generic_Parameterless_Function is ...

The formal generic parameter is the function result type. The method at the callee's side is implemented by a parameterless function defined as:

type Implementation is access function
    
Callee : access Call_Service'Class;
        Caller : access Call_Service'Class
     )  return Result_Type;

It has the parameters Callee and Caller identifying two ends of the call.

type Remote_Function is new Abstract_Method with private;

The type Remote_Function is an implementation of synchronously called parameterless function with the following primitive operations:

function Call
         (  Method  : Remote_Function;
            Callee  : Call_Service'Class / Call_Service_ID;
            Timeout : Duration := Duration'Last
         )  return Result_Type;

This procedure performs synchronous remote call to Method on Callee.

Exceptions
Program_Error Not implemented (the implementation is not set)
Status_Error The method or call service is not initialized
Timeout_Error The call is timed out
Use_Error The caller and the callee Call_Services are the same or the method is not handled by this Call_Service
other An exception propagated at the callee side

procedure Set
          (  Method  : in out Remote_Function;
             Handler : Implementation
          );

This procedure must be called on the callee's side to set the implementation of the procedure. Each process can have its own implementation.

The package Synchronization.Interprocess.Process_Call_Service.Get_String is an instance of Generic_Parameterless_Function with the type string.

12.11.3. Unary generic procedures

The convenience generic child package Synchronization.Interprocess.Process_Call_Service.Generic_Unary_Procedure provides an implementation of synchronous and asynchronous methods with single parameter.

generic
   type
Argument_Type (<>) is private;
package
Synchronization.Interprocess.Process_Call_Service.
        Generic_Unary_Procedure is ...

The formal generic parameter is the type of the procedure's parameter. The method at the callee's side is implemented by a procedure with one parameter defined as either:

type Immutable_Implementation is access procedure
    
Argument : Argument_Type;
        Callee   : in out Call_Service'Class;
        Caller   : in out Call_Service'Class
     );
type Mutable_Implementation is access procedure
    
Argument : in out Argument_Type;
        Callee   : in out Call_Service'Class;
        Caller   : in out Call_Service'Class
     );

The parameter Argument is the remote procedure parameter. There are two variants one with an immutable and another with a mutable parameter. The mutable variant is used in the calls returning the updated parameter back. Other parameters Callee and Caller identify two ends of the call.

type Asynchronous_Procedure is new Abstract_Method with private;

The type Asynchronous_Procedure is an implementation of asynchronously called procedures with the following primitive operations:

procedure Call
          (  Method   : Asynchronous_Procedure;
             Callee   : Call_Service'Class / Call_Service_ID;
             Argument : Argument_Type;
             Timeout  : Duration := Duration'Last
          );

This procedure performs asynchronous remote call to Method on Callee with the parameter Argument.

Exceptions
Status_Error The method or call service is not initialized
Timeout_Error The call is timed out
Use_Error The caller and the callee Call_Services are the same or the method is not handled by this Call_Service

procedure Set
          (  Method  : in out Asynchronous_Procedure;
             Handler : Immutable_Implementation
          );

This procedure must be called on the callee's side to set the implementation of the procedure. Each process can have its own implementation.

type Synchronous_Immutable_Procedure is new Abstract_Method with private;

The type Synchronous_Immutable_Procedure is an implementation of synchronously called procedures with the following primitive operations:

procedure Call
          (  Method   : Synchronous_Immutable_Procedure;
             Callee   : Call_Service'Class / Call_Service_ID;
             Argument : Argument_Type;
             Timeout  : Duration := Duration'Last
          );

This procedure performs synchronous remote call to Method on Callee with the parameter Argument.

Exceptions
Program_Error Not implemented (the implementation is not set)
Status_Error The method or call service is not initialized
Timeout_Error The call is timed out
Use_Error The caller and the callee Call_Services are the same or the method is not handled by this Call_Service
other An exception propagated at the callee side

procedure Set
          (  Method  : in out Synchronous_Immutable_Procedure;
             Handler : Immutable_Implementation
          );

This procedure must be called on the callee's side to set the implementation of the procedure. Each process can have its own implementation.

type Synchronous_Mutable_Procedure is new Abstract_Method with private;

The type Synchronous_Mutable_Procedure is an implementation of synchronously called procedures with the following primitive operations:

procedure Call
          (  Method   : Synchronous_Immutable_Procedure;
             Callee   : Call_Service'Class / Call_Service_ID;
             Argument : in out Argument_Type;
             Timeout  : Duration := Duration'Last
          );

This procedure performs synchronous remote call to Method on Callee with the in-out parameter Argument.

Exceptions
Program_Error Not implemented (the implementation is not set)
Status_Error The method or call service is not initialized
Timeout_Error The call is timed out
Use_Error The caller and the callee Call_Services are the same or the method is not handled by this Call_Service
other An exception propagated at the callee side

procedure Set
          (  Method  : in out Synchronous_Mutable_Procedure;
             Handler : Mutable_Implementation
          );

This procedure must be called on the callee's side to set the implementation of the procedure. Each process can have its own implementation.

The package Synchronization.Interprocess.Process_Call_Service.Set_String is an instance of Generic_Unary_Procedure with the type string.

12.11.4. Unary generic functions

The convenience generic child package Synchronization.Interprocess.Process_Call_Service.Generic_Unary_Function provides an implementation of functions with single parameter:

generic
   type
Argument_Type (<>) is private;
   type
Result_Type   (<>) is private;
package
Synchronization.Interprocess.Process_Call_Service.
        Generic_Unary_Function is ...

The formal generic parameters are the function parameter and the function result type. The method at the callee's side is implemented by a function with one parameter defined as:

type Implementation is access function
     (  Argument : Argument_Type;
        Callee   : access Call_Service'Class;
        Caller   : access Call_Service'Class
     )  return Result_Type;

It has the parameters Callee and Caller identifying two ends of the call.

type Remote_Function is new Abstract_Method with private;

The type Remote_Function is an implementation of synchronously called function with the following primitive operations:

function Call
         (  Method   : Remote_Function;
            Callee   : Call_Service'Class / Call_Service_ID;
            Argument : Argument_Type;
            Timeout  : Duration := Duration'Last
         )  return Result_Type;

This procedure performs synchronous remote call to Method on Callee with the parameter Argument.

Exceptions
Program_Error Not implemented (the implementation is not set)
Status_Error The method or call service is not initialized
Timeout_Error The call is timed out
Use_Error The caller and the callee Call_Services are the same or the method is not handled by this Call_Service
other An exception propagated at the callee side

procedure Set
          (  Method  : in out Remote_Function;
             Handler : Implementation
          );

This procedure must be called on the callee's side to set the implementation of the procedure. Each process can have its own implementation.

The package Synchronization.Interprocess.Process_Call_Service.Process_String is an instance of Generic_Unary_Function with the type string.

12.11.5. Dyadic generic procedures

The convenience generic child package Synchronization.Interprocess.Process_Call_Service.Generic_Dyadic_Procedure provides an implementation of synchronous and asynchronous methods with two parameters.

generic
   type
Argument_1_Type (<>) is private;
   type
Argument_2_Type (<>) is private;
package
Synchronization.Interprocess.Process_Call_Service.
        Generic_Dyadic_Procedure is ...

The formal generic parameters are the types of the procedure's parameters. The method at the callee's side is implemented by a procedure with two parameters defined as either of:

type Immutable_Implementation is access procedure
    
Argument_1 : Argument_1_Type;
        Argument_2 : Argument_2_Type;
        Callee     : in out Call_Service'Class;
        Caller     : in out Call_Service'Class
     );
type Mutable_Implementation is access procedure
    
Argument_1 : in out Argument_1_Type;
        Argument_2 : in out Argument_2_Type;
        Callee     : in out Call_Service'Class;
        Caller     : in out Call_Service'Class
     );

The parameters Argument_1 and Argument_2 are the remote procedure parameters. There are two variants one with an immutable and another with a mutable parameters. The mutable variant is used in the calls returning the updated parameters back. Other parameters Callee and Caller identify two ends of the call.

type Asynchronous_Procedure is new Abstract_Method with private;

The type Asynchronous_Procedure is an implementation of asynchronously called procedures with the following primitive operations:

procedure Call
          (  Method     : Asynchronous_Procedure;
             Callee     : Call_Service'Class / Call_Service_ID;
             Argument_1 : Argument_1_Type;
             Argument_2 : Argument_2_Type;
             Timeout    : Duration := Duration'Last
          );

This procedure performs asynchronous remote call to Method on Callee with the parameter Argument.

Exceptions
Status_Error The method or call service is not initialized
Timeout_Error The call is timed out
Use_Error The caller and the callee Call_Services are the same or the method is not handled by this Call_Service

procedure Set
          (  Method  : in out Asynchronous_Procedure;
             Handler : Immutable_Implementation
          );

This procedure must be called on the callee's side to set the implementation of the procedure. Each process can have its own implementation.

type Synchronous_Immutable_Procedure is new Abstract_Method with private;

The type Synchronous_Immutable_Procedure is an implementation of synchronously called procedures with the following primitive operations:

procedure Call
          (  Method     : Synchronous_Immutable_Procedure;
             Callee     : Call_Service'Class / Call_Service_ID;
             Argument_1 : Argument_1_Type;
             Argument_2 : Argument_2_Type;
             Timeout    : Duration := Duration'Last
          );

This procedure performs synchronous remote call to Method on Callee with the parameters Argument_1 and Argument_2.

Exceptions
Program_Error Not implemented (the implementation is not set)
Status_Error The method or call service is not initialized
Timeout_Error The call is timed out
Use_Error The caller and the callee Call_Services are the same or the method is not handled by this Call_Service
other An exception propagated at the callee side

procedure Set
          (  Method  : in out Synchronous_Immutable_Procedure;
             Handler : Immutable_Implementation
          );

This procedure must be called on the callee's side to set the implementation of the procedure. Each process can have its own implementation.

type Synchronous_Mutable_Procedure is new Abstract_Method with private;

The type Synchronous_Mutable_Procedure is an implementation of synchronously called procedures with the following primitive operations:

procedure Call
          (  Method     : Synchronous_Immutable_Procedure;
             Callee     : Call_Service'Class / Call_Service_ID;
             Argument_1 : in out Argument_1_Type;
             Argument_2 : in out Argument_2_Type;
             Timeout    : Duration := Duration'Last
          );

This procedure performs synchronous remote call to Method on Callee with the in-out parameters Argument_1 and Argument_2.

Exceptions
Program_Error Not implemented (the implementation is not set)
Status_Error The method or call service is not initialized
Timeout_Error The call is timed out
Use_Error The caller and the callee Call_Services are the same or the method is not handled by this Call_Service
other An exception propagated at the callee side

procedure Set
          (  Method  : in out Synchronous_Mutable_Procedure;
             Handler : Mutable_Implementation
          );

This procedure must be called on the callee's side to set the implementation of the procedure. Each process can have its own implementation.ng.

12.11.6. Dyadic generic functions

The convenience generic child package Synchronization.Interprocess.Process_Call_Service.Generic_Dyadic_Function provides an implementation of functions with two parameters:

generic
   type
Argument_1_Type (<>) is private;
   type
Argument_2_Type (<>) is private;
   type
Result_Type     (<>) is private;
package
Synchronization.Interprocess.Process_Call_Service.
        Generic_Dyadic_Function is ...

The formal generic parameters are the function parameters and the result types. The method at the callee's side is implemented by a function defined as:

type Implementation is access function
     (  Argument_1 : Argument_1_Type;
        Argument_2 : Argument_2_Type;
        Callee     : access Call_Service'Class;
        Caller     : access Call_Service'Class
     )  return Result_Type;

It has the parameters Callee and Caller identifying two ends of the call.

type Remote_Function is new Abstract_Method with private;

The type Remote_Function is an implementation of synchronously called function with the following primitive operations:

function Call
         (  Method     : Remote_Function;
            Callee     : Call_Service'Class / Call_Service_ID;
            Argument_1 : Argument_1_Type;
            Argument_2 : Argument_2_Type;
            Timeout    : Duration := Duration'Last
         )  return Result_Type;

This procedure performs synchronous remote call to Method on Callee with the parameters Argument_1 and Argument_2.

Exceptions
Program_Error Not implemented (the implementation is not set)
Status_Error The method or call service is not initialized
Timeout_Error The call is timed out
Use_Error The caller and the callee Call_Services are the same or the method is not handled by this Call_Service
other An exception propagated at the callee side

procedure Set
          (  Method  : in out Remote_Function;
             Handler : Implementation
          );

This procedure must be called on the callee's side to set the implementation of the procedure. Each process can have its own implementation.

12.11.7. Ternary generic procedures

The convenience generic child package Synchronization.Interprocess.Process_Call_Service.Generic_Ternary_Procedure provides an implementation of synchronous and asynchronous methods with three parameters.

generic
   type
Argument_1_Type (<>) is private;
   type
Argument_2_Type (<>) is private;
   type
Argument_3_Type (<>) is private;
package
Synchronization.Interprocess.Process_Call_Service.
        Generic_Ternary_Procedure is ...

The formal generic parameters are the types of the procedure's parameters. The method at the callee's side is implemented by a procedure with three parameters defined as either of:

type Immutable_Implementation is access procedure
    
Argument_1 : Argument_1_Type;
        Argument_2 : Argument_2_Type;
        Argument_3 : Argument_3_Type;
        Callee     : in out Call_Service'Class;
        Caller     : in out Call_Service'Class
     );
type Mutable_Implementation is access procedure
    
Argument_1 : in out Argument_1_Type;
        Argument_2 : in out Argument_2_Type;
        Argument_3 : in out Argument_3_Type;
        Callee     : in out Call_Service'Class;
        Caller     : in out Call_Service'Class
     );

The parameters Argument_1, Argument_2 and Argument_3 are the remote procedure parameters. There are two variants one with an immutable and another with a mutable parameters. The mutable variant is used in the calls returning the updated parameters back. Other parameters Callee and Caller identify two ends of the call.

type Asynchronous_Procedure is new Abstract_Method with private;

The type Asynchronous_Procedure is an implementation of asynchronously called procedures with the following primitive operations:

procedure Call
          (  Method     : Asynchronous_Procedure;
             Callee     : Call_Service'Class / Call_Service_ID;
             Argument_1 : Argument_1_Type;
             Argument_2 : Argument_2_Type;
             Argument_3 : Argument_3_Type;
             Timeout    : Duration := Duration'Last
          );

This procedure performs asynchronous remote call to Method on Callee with the parameter Argument.

Exceptions
Status_Error The method or call service is not initialized
Timeout_Error The call is timed out
Use_Error The caller and the callee Call_Services are the same or the method is not handled by this Call_Service

procedure Set
          (  Method  : in out Asynchronous_Procedure;
             Handler : Immutable_Implementation
          );

This procedure must be called on the callee's side to set the implementation of the procedure. Each process can have its own implementation.

type Synchronous_Immutable_Procedure is new Abstract_Method with private;

The type Synchronous_Immutable_Procedure is an implementation of synchronously called procedures with the following primitive operations:

procedure Call
          (  Method     : Synchronous_Immutable_Procedure;
             Callee     : Call_Service'Class / Call_Service_ID;
             Argument_1 : Argument_1_Type;
             Argument_2 : Argument_2_Type;
             Argument_3 : Argument_3_Type;
             Timeout    : Duration := Duration'Last
          );

This procedure performs synchronous remote call to Method on Callee with the parameters Argument_1, Argument_2 and Argument_3.

Exceptions
Program_Error Not implemented (the implementation is not set)
Status_Error The method or call service is not initialized
Timeout_Error The call is timed out
Use_Error The caller and the callee Call_Services are the same or the method is not handled by this Call_Service
other An exception propagated at the callee side

procedure Set
          (  Method  : in out Synchronous_Immutable_Procedure;
             Handler : Immutable_Implementation
          );

This procedure must be called on the callee's side to set the implementation of the procedure. Each process can have its own implementation.

type Synchronous_Mutable_Procedure is new Abstract_Method with private;

The type Synchronous_Mutable_Procedure is an implementation of synchronously called procedures with the following primitive operations:

procedure Call
          (  Method     : Synchronous_Immutable_Procedure;
             Callee     : Call_Service'Class / Call_Service_ID;
             Argument_1 : in out Argument_1_Type;
             Argument_2 : in out Argument_2_Type;
             Argument_3 : in out Argument_3_Type;
             Timeout    : Duration := Duration'Last
          );

This procedure performs synchronous remote call to Method on Callee with the in-out parameters Argument_1, Argument_2 and Argument_3.

Exceptions
Program_Error Not implemented (the implementation is not set)
Status_Error The method or call service is not initialized
Timeout_Error The call is timed out
Use_Error The caller and the callee Call_Services are the same or the method is not handled by this Call_Service
other An exception propagated at the callee side

procedure Set
          (  Method  : in out Synchronous_Mutable_Procedure;
             Handler : Mutable_Implementation
          );

This procedure must be called on the callee's side to set the implementation of the procedure. Each process can have its own implementation.ng.

12.11.8. Ternary generic functions

The convenience generic child package Synchronization.Interprocess.Process_Call_Service.Generic_Ternary_Function provides an implementation of functions with two parameters:

generic
   type
Argument_1_Type (<>) is private;
   type
Argument_2_Type (<>) is private;
   type
Argument_3_Type (<>) is private;
   type
Result_Type     (<>) is private;
package
Synchronization.Interprocess.Process_Call_Service.
        Generic_Dyadic_Function is ...

The formal generic parameters are the function parameters and the result types. The method at the callee's side is implemented by a function defined as:

type Implementation is access function
    
Argument_1 : Argument_1_Type;
        Argument_2 : Argument_2_Type;
        Argument_3 : Argument_3_Type;
        Callee     : access Call_Service'Class;
        Caller     : access Call_Service'Class
     )  return Result_Type;

It has the parameters Callee and Caller identifying two ends of the call.

type Remote_Function is new Abstract_Method with private;

The type Remote_Function is an implementation of synchronously called function with the following primitive operations:

function Call
         (  Method     : Remote_Function;
            Callee     : Call_Service'Class / Call_Service_ID;
            Argument_1 : Argument_1_Type;
            Argument_2 : Argument_2_Type;
            Argument_3 : Argument_3_Type;
            Timeout    : Duration := Duration'Last
         )  return Result_Type;

This procedure performs synchronous remote call to Method on Callee with the parameters Argument_1, Argument_2 and Argument_3.

Exceptions
Program_Error Not implemented (the implementation is not set)
Status_Error The method or call service is not initialized
Timeout_Error The call is timed out
Use_Error The caller and the callee Call_Services are the same or the method is not handled by this Call_Service
other An exception propagated at the callee side

procedure Set
          (  Method  : in out Remote_Function;
             Handler : Implementation
          );

This procedure must be called on the callee's side to set the implementation of the procedure. Each process can have its own implementation.

[Back][TOC][Next]

12.12. Arrays of call service objects

The generic package Synchronization.Interprocess.Process_Call_Service.Generic_Call_Service_Arrays provides arrays of Call_Services:

generic
   type
Process_ID is (<>);
   Request_Queue_Size   : Positive;
   Request_Stream_Size  : Stream_Element_Count;
   Response_Stream_Size : Stream_Element_Count;
package Synchronization.Interprocess.Process_Call_Service.
        Generic_Call_Service_Arrays is ...

The package declares the type:

subtype Call_Service_Instance is
     
  Call_Service
        (  Request_Queue_Size   => Request_Queue_Size,
           Request_Stream_Size  => Request_Stream_Size,
           Response_Stream_Size => Response_Stream_Size
        );
type
Call_Service_Array is
   array
(Process_ID) of aliased Call_Service_Instance;

[Back][TOC][Next]

12.13. Call service manager

The package Synchronization.Interprocess.Process_Call_Service.Manager provides a simplified way to manage a set of Call_Service objects

type Call_Service_Manager
     (  Size                 : Call_Service_ID;
        Request_Queue_Size   : Positive;
        Request_Stream_Size  : Stream_Element_Count;
        Response_Stream_Size : Stream_Element_Count
     )  is new Abstract_Shared_Object with private;

The object Call_Service_Manager keeps an array of Call_Service objects. The discriminants are:

The following primitive operations are defined on the type:

procedure Finalize (Manager : in out Call_Service_Manager);

This procedure is called upon finalization. It releases the Call_Service object that runs in the server mode. When overridden it must be called from the new implementation.

function Get_Server
         (  Manager : Call_Service_Manager
         )  return Call_Service_Ptr;

This function returns pointer to the Call_Service running the server for the process. Status_Error is propagated when the manager is not initialized.

function Get_Server_ID
         (  Manager : Call_Service_Manager
         )  return Call_Service_ID;

This function returns the identifier of the Call_Service object running the server for the process. Status_Error is propagated when the manager is not initialized.

function Get_Service
         (  Manager : Call_Service_Manager;
            ID      : Call_Service_ID
         )  return Call_Service_Ptr;

This function returns pointer to the Call_Service corresponding to ID. Constraint_Error is propagated when ID is not in 1..Manager.Size. Status_Error is propagated when the manager is not initialized.

function Get_Service
         (  Manager : Call_Service_Manager;
            ID      : Process_ID
         )  return Call_Service_Ptr;

This function returns pointer to the Call_Service corresponding to the process ID. The process is specified by the OS-dependent identifier. E.g. it is equivalent to pid_t under Linux or DWORD under Windows. Constraint_Error is propagated when ID does not specify a process running a service. Status_Error is propagated when the manager is not initialized.

procedure Initialize (Manager : in out Call_Service_Manager);

This procedure is called upon initialization. When overridden it must be called from the new implementation.

type Services_List is array (Positive range <>) of Call_Service_ID;
procedure Wait_For_Initialization
          (  Manager  : in out Call_Service_Manager;
           [ Services : Services_List; ]
             Timeout  : Duration := Duration'Last
          );

These procedures are used to wait for processes to come. The parameter Services is the list of identifiers of Call_Service to initialize. When omitted the procedure awaits for all objects managed by Manager. Constraint_Error is propagated when some elements in Services are outside the range 1..Manager.Size. Status_Error is propagated when the manager is not initialized.

[Back][TOC][Next]

12.14. Remote procedure call example

The following example illustrates a remote procedure call equivalent of Hello world. The server responds to a greeting call from the client and then both exit.

12.14.1. The server

File test_hello_rpc_server_data.ads:
with Synchronization.Interprocess.Process_Call_Service.Process_String;
with Synchronization.Interprocess.Process_Call_Service.Manager;

package Test_Hello_RPC_Server_Data is
   use
Synchronization.Interprocess;
   use Process_Call_Service;
   use Process_String;
   use Manager;

   type Shared_Data is new Abstract_Shared_Environment with record
      Greeting : Remote_Function;
      Services : Call_Service_Manager (2, 10, 100, 100);
   end record;

   Data : Shared_Data;

   function Hello
            (  Text   : String;
               Callee : access Call_Service'Class;
               Caller : access Call_Service'Class
            )  return String;

end Test_Hello_RPC_Server_Data;

The package declares sharing environment object Data of the type Shared_Data. The environment contains method Greeting, which provides a String-valued function with single String parameter. The type is defined in the instance Process_String of the generic package Synchronization.Interprocess.Process_Call_Service. The second member of Data is a Call_Service.Manager for two processes with 100 elements of stream buffer for each. The function Hello serves as an implementation of the method Greeting.

File test_hello_rpc_server_data.adb:
with Ada.Text_IO;  use Ada.Text_IO;

package body Test_Hello_RPC_Server_Data is

   function
Hello
            (  Text   : String;
               Callee : access Call_Service'Class;
               Caller : access Call_Service'Class
            )  return String is
   begin

      Put_Line
      (  "Greeting from "
      &  Image (Get_ID (Callee.all))
      &  ": "
      &  Text
      );
      return "Hello there";
   end Hello;

begin
   Set (Data.Greeting, Hello'Access); -- Assign handler
end Test_Hello_RPC_Server_Data;

The package defines the body of the function Hello which prints its parameter and returns the string Hello there back. The function is assigned as the implementation of the method Data.Greeting upon package elaboration.

File test_hello_rpc_server.adb:
with Ada.Text_IO;                 use Ada.Text_IO;
with Test_Hello_RPC_Server_Data;  use Test_Hello_RPC_Server_Data;

with Synchronization.Interprocess.Process_Call_Service.Manager;

procedure Test_Hello_RPC_Server is
   use
Synchronization.Interprocess.Process_Call_Service;
   use Manager;
begin
   Open (Data, "test_call_service", True);
   Put ("Waiting for the client ... ");
   Wait_For_Initialization (Data.Services);
   Put_Line (" OK");
   Put_Line ("Servicing for 5s");
   delay 5.0; -- Wait before exit
   Put_Line ("Done");
end Test_Hello_RPC_Server;

The server implementation opens the sharing environment. If the environment not yet exists it is created. Therefore the server and the client can start in any order. After that the server waits for the client to join. The procedure Wait_For_Initialization is used for this. Then the server lingers for 5 seconds giving the client time to call it.

12.14.2. The client

File test_hello_rpc_client_data.ads:
with Synchronization.Interprocess.Process_Call_Service.Process_String;
with Synchronization.Interprocess.Process_Call_Service.Manager;

package Test_Hello_RPC_Client_Data is
   use
Synchronization.Interprocess;
   use Process_Call_Service;
   use Process_String;
   use Manager;

   type Shared_Data is new Abstract_Shared_Environment with record
      Greeting : Remote_Function;
      Services : Call_Service_Manager (2, 10, 100, 100);
   end record;

   Data : Shared_Data;

end Test_Hello_RPC_Client_Data;

This package is identical to its server counterpart except that it does not provide any implementation for the method Greeting.

File test_hello_rpc_server.adb:

with Ada.Text_IO;                 use Ada.Text_IO;
with Test_Hello_RPC_Server_Data;  use Test_Hello_RPC_Server_Data;

with Synchronization.Interprocess.Process_Call_Service.Manager;
with Synchronization.Interprocess.Process_Call_Service.Process_String;

procedure Test_Hello_RPC_Client is
   use
Synchronization.Interprocess.Process_Call_Service;
   use Manager;
   use Process_String;
   Server : Call_Service_ID;
begin
   Open (Data, "test_call_service", True);
   Put ("Waiting for the server ... ");
   Wait_For_Initialization (Data.Services);
   Put_Line (" OK");
   if Get_Server_ID (Data.Services) = 1 then -- Select the other party
      Server := 2;
   else
      Server := 1;
   end if;
   Put ("Saying hello ... ");
   Put_Line (Call (Data.Greeting, Server, "Who is here?"));
   Put_Line ("Done");
end Test_Hello_RPC_Client;;

The client implementation opens the sharing environment like the server does and similarly it waits for the server to join by calling Wait_For_Initialization. Then the client determines the identifier of the server as the value different to client's identifier. After that the client calls the method Data.Greeting on the server with the parameter Who is here? and prints the response.


[Back][TOC][Next]

13. Parsers

Parsers can be used for syntax analysis of infix expressions, i.e. ones containing infix (dyadic), prefix and postfix operators, brackets, function calls, array indices etc. The approach presented does not require any grammar put down to generate scanner and analyzer. Nor any code generation steps are required. An object-oriented approach is used instead. The lexical procedures are dispatching, so that implementations may be provided through overriding them. Parsers can be used both for immediate one-pass code interpretation and for parsing tree building. Parser automatically detects the expression end allowing its easy integration. Operator precedence is expressed in a native way by setting priorities controlling association with the operands. Associations with the left and right side operands are controlled independently. Commutative operators and their inverses can be optimized when necessary. Especial attention is paid to error handling allowing generating very precise error messages and source code references. Samples from a small console calculator to a complete parsing tree generator for Ada 95 expressions illustrate examples of use.

The parsing method used is an extended variant of an algorithm of infix to postfix notation conversion. I do not know who was its author. Already in 1975 T. Pratt in Programming Languages, design and implementation mentioned it as well known. The algorithm makes possible parsing and interpreting infix expressions in one pass without returns. The following figure drafts out the idea and its implementation.

parser

Quick reference:

[Back][TOC][Next]

13.1. Example first, a small calculator

In this paragraph I present an implementation of a small primitive floating point calculator. The calculator supports operations +, -, *, /, **, brackets () and unary operators +, -, abs.

File calculator.ads:
with Parsers.String_Source;  use Parsers.String_Source;
with Parsers.Generic_Lexer.Blanks;
with Parsers.Generic_Token.Segmented_Lexer;
with Tables.Names;

package Calculator is
--
-- Calculate -- A primitive floating-point calculator
--
--    Formula - To be evaluated
--
-- Returns :
--
--    The result of Formula
--
-- Exceptions :
--
--    Syntax_Error  - Any syntax error
--    Numeric_Error - Any numeric error
--

   function Calculate (Formula : String) return Float;

private
--
-- Operations -- All the operations supported
--

   type Operations is
        (  Add, Sub, Mul, Div, Pow,    -- Infix operators
           Abs_Value, Plus, Minus,     -- Prefix operators
           Left_Bracket, Right_Bracket -- Brackets
        );
--
-- "and" -- Checks operation associations, always True (Ok)
--

   function "and" (Left, Right : Operations) return Boolean;
--
-- Is_Commutative -- No commutative operations, always False
--

   function Is_Commutative (Left, Right : Operations) return Boolean;
--
-- Is_Inverse -- No commutative operations, always False
--

   function Is_Inverse (Operation : Operations) return Boolean;
--
-- Group_Inverse -- No commutative operations, never called
--

   function Group_Inverse (Operation : Operations) return Operations;
--
-- Priorities -- The levels of association
--

   type Priorities is mod 10;
--
-- Tokens -- The lexical tokens
--

   package Tokens is
      new
Parsers.Generic_Token
          (  Operation_Type => Operations,
             Argument_Type  => Float,
             Priority_Type  => Priorities,
             Sources        => Code
          );
   use Tokens;
--
-- Check_Spelling -- Of a name, no checks
--

   procedure Check_Spelling (Name : String);
--
-- Check_Matched -- Check if no broken keyword matched
--

   function Check_Matched (Source : String; Pointer : Integer)
      return Boolean;
--
-- Token_Tables -- Case-insensitive tables of tokens
--

   package Token_Tables is new Tokens.Vocabulary.Names;
--
-- The tables of prefix, infix and postfix operations
--

   Prefixes  : aliased Token_Tables.Dictionary;
   Infixes   : aliased Token_Tables.Dictionary;
   Postfixes : aliased Token_Tables.Dictionary;
--
-- Lexers -- Table driven lexers
--

   package Lexers is new Tokens.Segmented_Lexer;
--
-- Blank_Skipping_Lexers -- Ones that skip blanks
--

   package Blank_Skipping_Lexers is
      new
Lexers.Token_Lexer.Implementation.Blanks (Lexers.Lexer);
--
-- Expression -- The lexer using our tables
--

   type Expression is
      new
Blank_Skipping_Lexers.Lexer
          (  Prefixes  => Prefixes'Access,
             Infixes   => Infixes'Access,
             Postfixes => Postfixes'Access
          )  with null record;
--
-- Call -- Evaluates an operator
--

   function Call
            (  Context   : access Expression;
               Operation : Tokens.Operation_Token;
               List      : Tokens.Arguments.Frame
            )  return Tokens.Argument_Token;
--
-- Enclose -- Evaluates an expression in brackets
--

   function Enclose
            (  Context : access Expression;
               Left    : Tokens.Operation_Token;
               Right   : Tokens.Operation_Token;
               List    : Tokens.Arguments.Frame
            )  return Tokens.Argument_Token;
--
-- Get_Operand -- Recognizes an operand (float number)
--

   procedure Get_Operand
             (  Context  : in out Expression;
                Code     : in out Source;
                Argument : out Tokens.Argument_Token;
                Got_It   : out Boolean
             );
end Calculator;

The package Calculator defines the function Calculate that takes a string argument and returns the result of the expression in the string. In the private part of the package, first the set of supported operations is defined, that is the enumeration type Operations. Then the following functions are defined on Operations to be used in generic instantiations:

Next the package defines the type Priority used for operation association levels. That can be any type with "<" order defined. The types Operations and Priority are used to instantiate the package Parsers.Generic_Token. The instance Tokens provides base types describing expression lexical tokens. That is the table type used to keep the legal names of the operations defined by the type Operations. The tables obtained are case sensitive. It is not exactly what is needed, because the expression should be case-insensitive. For this reason, the child table package Tables.Names is instantiated. To do this first, there should be defined two additional subroutines:

Tables.Names is instantiated as:

package Token_Tables is new Tokens.Vocabulary.Names;

Next three tables from obtained Token_Tables are declared. They are:

The final step is to create table-driven lexers using the tables we have. For this the package Parsers.Generic_Token.Segmented_Lexer is instantiated under the name Lexers. The instance Lexers has the type Lexer which can be used to parse expressions. This type is abstract because it has some abstract operations to implement. The first operation is Get_Blank used to skip blanks in the expression. The package Parsers.Generic_Lexer.Blanks provides an implementation that skips spaces, tabs etc. To use it Parsers.Generic_Lexer.Blanks is instantiated as Blank_Skipping_Lexers. The obtained type Lexer is then extended to set the type discriminants to the corresponding tables. The resulting type Expression is still abstract, but has only three things to define:

The implementation of the package is straightforward:

File calculator.adb:
with Ada.Characters.Handling;  use Ada.Characters.Handling;
with Ada.Exceptions;           use Ada.Exceptions;
with Ada.IO_Exceptions;        use Ada.IO_Exceptions;
with Strings_Edit;             use Strings_Edit;
with Strings_Edit.Floats;      use Strings_Edit.Floats;

with Ada.Numerics.Elementary_Functions;
use  Ada.Numerics.Elementary_Functions;

package body Calculator is

   function "and" (Left, Right : Operations) return Boolean is
   begin
      return
True;
   end "and";

   function Is_Commutative (Left, Right : Operations) return Boolean is
   begin
      return
False;
   end Is_Commutative;

   function Is_Inverse (Operation : Operations) return Boolean is
   begin
      return
False;
   end Is_Inverse;

   function Group_Inverse (Operation : Operations) return Operations is
   begin
      return
Minus;
   end Group_Inverse;

   procedure Check_Spelling (Name : String) is
   begin
      null
;
   end Check_Spelling;

   function Check_Matched (Source : String; Pointer : Integer)
      return Boolean is
   begin
      return

      (  not Is_Alphanumeric (Source (Pointer))
      or else
         not
Is_Alphanumeric (Source (Pointer - 1))
      );
   end Check_Matched;

The function Check_Matched receives the string being parsed and the index of the first character following the matched name (lexeme). It checks that no broken names be matched.

File calculator.adb (continuation):
   function Call
            (  Context   : access Expression;
               Operation : Tokens.Operation_Token;
               List      : Tokens.Arguments.Frame
            )  return Tokens.Argument_Token is
      Result : Float;
   begin
      case
Operation.Operation is
         when
Abs_Value =>
            Result := abs List (List'First).Value;
         when Add =>
            Result := List (List'First).Value + List (List'Last).Value;
         when Sub =>
            Result := List (List'First).Value - List (List'Last).Value;
         when Mul =>
            Result := List (List'First).Value * List (List'Last).Value;
         when Div =>
            Result := List (List'First).Value / List (List'Last).Value;
         when Pow =>
            Result :=
               exp (log (List (List'First).Value) * List (List'Last).Value);
         when Plus =>
            Result := List (List'First).Value;
         when Minus =>
            Result := -List (List'First).Value;
         when others =>
            raise Program_Error;
      end case;
      if Result'Valid then
         return (Result, Operation.Location & Link (List));
      else
         Raise_Exception
         (  Numeric_Error'Identity,
            (  "Numeric error in "
            &  Operations'Image (Operation.Operation)
            &  " at " & Image (Operation.Location)
         )  );
      end if;
   exception
      when
Program_Error =>
         raise;
      when others =>
         Raise_Exception
         (  Constraint_Error'Identity,
            (  "Numeric error in "
            &  Operations'Image (Operation.Operation)
            &  " at " & Image (Operation.Location)
         )  );
   end Call;

Call implements operators. The parameter Operation identifies what for operator. The parameter List contains the operands. Each operand has value (the Value field) and location in the source (the Location field). When evaluated operator also returns a value and location. The new location is evaluated from the locations of the operands (function Link) and the operator.

File calculator.adb (continuation):
   function Enclose
            (  Context : access Expression;
               Left    : Tokens.Operation_Token;
               Right   : Tokens.Operation_Token;
               List    : Tokens.Arguments.Frame
            )  return Tokens.Argument_Token is
   begin
      return

      (  List (List'First).Value,
         Left.Location & Right.Location
      );
   end Enclose;

Enclose implements brackets. Order brackets () just return the operand.

File calculator.adb (continuation):
   procedure Get_Operand
             (  Context  : in out Expression;
                Code     : in out Source;
                Argument : out Tokens.Argument_Token;
                Got_It   : out Boolean
             )  is
      Line    : String renames Get_Line (Code);
      Pointer : Integer := Get_Pointer (Code);
      Value   : Float;
   begin
      Get (Line, Pointer, Value);
      Set_Pointer (Code, Pointer);
      Argument := (Value, Link (Code));
      Got_It   := True;
   exception
      when End_Error =>
         Got_It := False;
      when Constraint_Error =>
         Set_Pointer (Code, Pointer);
         Raise_Exception
         (  Numeric_Error'Identity,
            "Too large number at " & Image (Link (Code))
         );
      when Data_Error =>
         Set_Pointer (Code, Pointer);
         Raise_Exception
         (  Parsers.Syntax_Error'Identity,
            "Wrong number at " & Image (Link (Code))
         );
   end Get_Operand;

The procedure Get_Operand gets the operand in the source. It uses Get_Line to access the current source line. Get_Pointer returns where it should start. The procedure Get from Strings_Edit.Floats is used to get a floating-point number. The Set_Pointer advances the source cursor to the position next to the number. The function Link is used to get the location of the number matched.

File calculator.adb (continuation):
   Reckoner : Expression;

   function Calculate (Formula : String) return Float is
      Copy   : aliased String := Formula;
      Code   : Source (Copy'Access);
      Result : Tokens.Argument_Token;
   begin
      Lexers.Parse (Reckoner, Code, Result);
      if Get_Pointer (Code) <= Copy'Last then
         Raise_Exception
         (  Parsers.Syntax_Error'Identity,
            (  "Unrecognized '"
            &  Copy (Get_Pointer (Code)..Copy'Last)
            &  "'"
         )  );
      end if;
      return Result.Value;
   end Calculate;

The procedure Calculate implements the calculator. It just calls Parse to interpret Formula and the checks that the whole string was matched.

File calculator.adb (continuation):
begin
   Add_Operator (Prefixes, "abs", Abs_Value, 87);
   Add_Operator (Prefixes, "+",   Plus,      8, 7);
   Add_Operator (Prefixes, "-",   Minus,     8, 7);
   Add_Bracket  (Prefixes, "(",   Left_Bracket);

   Add_Operator (Infixes, "+",  Add, 1, 2);
   Add_Operator (Infixes, "-",  Sub, 1, 3);
   Add_Operator (Infixes, "*",  Mul, 3, 4);
   Add_Operator (Infixes, "/",  Div, 3, 4);
   Add_Operator (Infixes, "**", Pow, 9, 5);

   Add_Bracket  (Postfixes, ")", Right_Bracket);
end Calculator;

Finally upon package elaboration the tables have to be filled in. Add_Operator is used to add an operator. The operator priorities are chosen to satisfy usual association rules. Add_Bracket is used to add brackets.

A program using the calculator may look as follows:

File console_calculator.adb:
with Ada.Exceptions;       use Ada.Exceptions;
with Ada.Text_IO;          use Ada.Text_IO;
with Strings_Edit.Floats;  use Strings_Edit.Floats;
with Calculator;           use Calculator;
with Parsers;

procedure Console_Calculator is
   Text : String (1..120);
   Last : Integer;
begin
   Put_Line ("Enter an expression to calculate and hit <enter>");
   Put_Line ("The operations supported are +, -, /, *, **, abs, ()");
   Put_Line ("   (to exit enter an empty string)");
   loop
      Put (">");
      Get_Line (Text, Last);
      exit when Last < Text'First;
      begin
         Put_Line ("=" & Image (Calculate (Text (1..Last))));
      exception
         when Error : Numeric_Error | Parsers.Syntax_Error =>
            Put_Line (Exception_Message (Error));
      end;
   end loop;
exception
   when Error : others =>
      Put ("Error :");
      Put_Line (Exception_Information (Error));
end Console_Calculator;

[Back][TOC][Next]

13.2. Basic considerations

An expression is a sequence of symbols involving operations applied to operands. In programming languages expression is a formula used to compute a value. In most general way any expression has the following syntax:

<expression>   ::=   <prefix>   <operand>   <postfix>   [   <infix>   <expression>   ]

Here <prefix> denotes any list of prefix operations, <postfix> does any list of postfix operations, <infix> is always exactly one infix operation.

For example in the following C++ expression:

! f ( 3 + x++ )

Operands here are f, 3 and x. Prefix operation is ! (logical not). Postfix operations are ++ (post-increment) and right bracket ). Infix operations are the operator + and the left bracket (.

The above syntax defines three kinds of operations depending of the context they may appear. We will use different colors to highlight the operation context.

13.2.1. Types of lexical tokens

The operations are further subdivided into operators, delimiters (like brackets), commas and ligatures, and reserved keywords used as modifiers.

Operators:

Brackets, commas, ligatures:

Foo (Left=>X, Right=>Y);

Argument sublists are quite common in mathematical notation. For example a hypergeometric function:

F (x1, x2, x3; y1, y2, y3 | z)

Here ; and | are semicolons separating sublists of the argument list. If ; has higher priority than | the above means:

()
                               
      (|       |)
                             
    (; ;|    
                               
  F    x1   x2   x3   y1   y2   y3    z  

Argument lists and sublists are always bound by two operations, the left and the right one. There are three kinds of semicolons:

(A, B with C, D with E)

  ()      
                 
        with)
                   
                with)
                   
  A     B     C     D     E  

Modifiers:

The modifiers can be used to stop expression parsing at reserved keywords. Thus in Ada the same then when does not follow and, manifests the expression end in an if-statement.

13.2.2. Priorities and association

Association of the operators with the operands is usually controlled by the precedence level (the operator priority) and special rules for the case when the priorities are same. Here I propose a simpler and more general model. All operators have two priorities to control association with the operands on either side. So the left priority controls left-side association. Both unary and binary operators have the priorities. Binary infix operators normally have left and right priorities near to each other. To have left to right operand association the left priority should be slightly lower than the right one. The following example illustrates the process of operand association for A+B*C+D+E:

A + B * C + D + E =           +  
A 1+2 B 3*4 C 1+2 D 1+2 E =                    
A 1+2 B*4 C 1+2 D 1+2 E =       +      
A 1+2 B*C 1+2 D 1+2 E =                    
A+(B*C) 1+2 D 1+2 E = +        
(A+(B*C))+D 1+2 E =                    
((A+(B*C))+D)+E =     *        
((A+(B*C))+D)+E                    
    A     B     C     D     E  

Normally, the left priority of a prefix operator is higher than the right one and both are higher than the priorities of the infix operators so:

A - ++ -- B + C =     +  
A 1-2 10++9 10--9 B 1+2 C =            
A 1-2++9--B 1+2 C = -    
A 1-2++(--B) 1+2 C =            
A-(++(--B)) 1+2 C =     ++    
(A-(++(--B)))+C =     --    
(A-(++(--B)))+C =            
    A     B     C  

There might be exceptions from this rule as in the case of the exponentiation operator, where it is useful to have the left priority of ** higher than the right priority of the unary minus and the right priority of ** lower than left priority of the unary minus so, that -A**-B become:

- A ** - B = -
8-7 A 9**5 8-7 B = **
8-7 A**5-B =        
8-7 A**(-B)=     -
-(A**(-B))=        
-(A**(-B))   A     B  

The priorities of the postfix operators should be selected so that the left priority be very high, but lower than the right priorities of the prefix operators. The right priority should be slightly lower than the left one, but higher than the right priorities of the infix operators. Under these conditions:

A - ++ B ++ -- - C =     -  
A 1-2 10++9 B 7++8 7--8 1-2 C =            
A 1-2++B 7++8 7--8 1-2 C = -    
A 1-2 (++B)++7--8 1-2 C =            
A 1-2 ((++B)++)--1-2 C =     --    
A-((++B)++)--) 1-2 C =     ++    
(A-((++B)++)--))-C =     ++    
(A-((++B)++)--))-C            
    A     B     C  

The order of evaluation of the unary operations can be changed by setting appropriate priorities. In extreme cases it could involve infix operators as well:

A * ? B @ * C = @
A 3*4 1?2 B 2@1 3*4 C = *
A 3*41?2 B 2@1 3*4 C =            
?2 A*B 2@1 3*4 C =   ?      
?(A*B) 2@1 3*4 C = *    
(?(A*B)) 2@13*4 C =            
(?(A*B))*C 2@ =   A     B     C  
((?(A*B))*C)@ =      
((?(A*B))*C)@      

Association of a left index or function call bracket with the operand on the left is controlled by the left priority of the bracket. This priority is usually high because otherwise:

A ** B (C, D + E) = ()
A 9**5 B 4( C, D 1+2 E) =                    
A**B 4( C, D 1+2 E) = **     +
(A**B)( C, D+E) =                    
()(A**B, C, D+E)   A     B     C     D     E  

Here "()" denotes indexing or function call. Normally most of infix operators have lower priorities, with exception of component extraction which usually has a higher priority. Left index brackets have no right priority.

The aggregate, order left brackets, commas and ligatures have no association priorities. The following table summarizes the rules of choosing the operation priorities:

Operation Left Right Comment
Unary prefix operators High High, but slightly lower than the left one Right to left evaluation order. Normally unary operators have higher priorities than binary operators. However, in Ada we find that:

-A*B =

-
*
       
  A     B  
Unary postfix operators High Higher than the left one Usually both priorities are lower than ones of the prefix operators, so that prefix ones would be evaluated first, and the postfix ones next and left to right
Normal infix operators Moderate Slightly higher than the left one Left to right evaluation order. Operators like component extraction  A.B should have both priorities very high.
Assignment operator High Low This ensures that

A + B := C + D =

+
               
    :=
               
        +
               
  A     B     C     D  
Left index brackets Very high   Array indices and function usually have higher priority than most of infix operations, but not all of them:

A+B(C) =

A.B(C) =

+ ()
                       
    () .    
                       
  A     B     C     A     B     C  

Another case of association is represented by sublist semicolons. The semicolons also have an association priority with the arguments in the list. Although semicolon association priorities do not interact with the operators' ones:

(A + B : C, D | E : F, G | H)

()
                               
(| || |)
                               
(: :| |: :|    
+                        
                               
  A     B     C     D     E     F     G     H  

In this example the colon separator has higher priority than one of bar separator.

13.2.3. Association checks

Sometimes operations cannot be arbitrarily associated with each other. There are three cases where operation compatibility can be checked:

and B or C

is illegal. Here the infix operators "and" and "or" are incompatible. Order brackets should be used to make it legal. For instance:

and (B or C)

Unary operators also can be checked. In Ada both

+ - and   A**+2

are illegal (see Ada Language Reference Manual 4.4). When association checks are used for unary operators it is important to define association incompatibility relation transitive. I.e. if an operator x cannot be associated with operator y, but can be with z, then y cannot be associated with z. Otherwise some association error may remain undetected.

( A + B ]

The right square bracket is incompatible with the left round bracket.

13.2.4. Commutative operators

A commutative operation is one which result does not depend on the argument order. For example, numeric addition is commutative because a+b = b+a. When the result does not depend on the operands order, an expression can be optimized by choosing a preferable order among many possible. The preferable order, could be one evaluating the constants and invariants first. For example: 1+a+2 = (1+2)+a = 3+a. Optimization may also take advantage of an inverse operation of a commutative group: 1+a-4 = 1+a+(-4) = (1+(-4))+a = -3+a. Here addition is the operation of a commutative group. Subtraction is the inverse operation. Unary minus is defined as 0-x, where 0 is the group's zero element. To support optimizations of this kind the commutative operations and their inverses can be parsed so that multiple appearances of binary operators will be replaced by an equivalent multiple-operand operation. For example:

A + B - C + D + E

can result in:

+
                   
        -        
                   
  A     B     C     D     E  

Similarly:

A - B - C + D + E

can be parsed as:

-
                   
            - -
                   
  A     B     C     D     E  

Note that the original order can be always restored when the inverse unary operation is prevented from being specified explicitly. For this one can have two different unary minus operations one for explicit use and another used implicitly as the group inverse. So that later if a semantic analysis of the operands involved showed that they in fact were not commutative, then the corresponding optimizations could be omitted and the original order applied.

The following table summarizes the most frequently used commutative groups:

Operators Group's operation Its inverse Inverse unary operation
+, - addition subtraction Unary minus: 0-x
*, / multiplication division 1/x

The operations that are commutative, but usually have no inverse are: logical and bitwise and, or, xor; numerical min, max. Alternatives separator | in Ada is also commutative.

Commutative optimization can be also useful for non-commutative operations. Often it makes sense to make the component selector . commutative to simplify parsing tree.

[Back][TOC][Next]

13.3. The base package

The package Parsers is the parent package of all others. It defines:

type Token_Class is
   
 (  Operator,
        Bracket,
        Comma,
        Ligature,
        Index,
        Sublist_Close,
        Sublist_Separator,
        Sublist_Open,
        Postmodifier,
        Premodifier
     );

This type enumerates the classes of operations. It also defines the subtypes of the sublist separators (semicolons) and modifiers:

subtype Semicolon_Class is Token_Class
   range Sublist_Close..Sublist_Open;
subtype Modifier_Class is Token_Class
   range Postmodifier..Premodifier;

Further the package defines the exceptions:

Syntax_Error : exception;

The exception Syntax_Error is used by lexers. Usually it has information attached containing the error description and location.

Association_Error        : exception;
Missing_Right_Bracket    : exception;
Unexpected_Comma         : exception;
Unexpected_Operation     : exception;
Unexpected_Right_Bracket : exception;
Wrong_Comma_Type         : exception;
Wrong_Right_Bracket_Type : exception;

These exceptions are used when dealing with operation stacks. They are low-level ones, and normally never propagate out of a lexer unhandled.

[Back][TOC][Next]

13.4. Sources

The parser can scan different kinds of sources from plain strings to text files. The generic package Parsers.Generic_Source specifies the abstract interface of a source:

generic
   type
Source_Type (<>) is limited private;
   type Line_Ptr_Type is access constant String;
   type Location_Type is private;
   with function Get_Line (Code : Source_Type)
      return String is <>;
   with procedure Get_Line
                  (  Code    : Source_Type;
                     Line    : out Line_Ptr_Type;
                     Pointer : out Integer;
                     Last    : out Integer
                  )  is <>;
   with function Get_Pointer (Code : Source_Type)
      return Integer is <>;
   with function Get_Backup_Pointer (Code : Source_Type)
      return Integer is <>;
   with function Image (Link : Location_Type)
      return String is <>;
   with function Link (Code : Source_Type)
      return Location_Type is <>;
   with procedure Next_Line (Code : in out Source_Type) is <>;
   with procedure Reset_Pointer (Code : in out Source_Type) is <>;
   with procedure Set_Pointer
                  (  Code    : in out Source_Type;
                     Pointer : Integer
                  )  is <>;
   with function "&" (Left, Right : Location_Type)
      return Location_Type is <>;
package Parsers.Generic_Source is
end
Parsers.Generic_Source;

The package does not provide any operations of its own. It only defines the interface of a source. Here

type Source_Type (<>) is limited private;

is the type of a source. An implementation should maintain two source cursors (pointers). As the parser consumes the source text it advances the cursors. The source slice between two cursors specifies the last token recognized by the parser. It may return back to the token beginning. However if the source contains several lines or records, then cursors always point to same line, so a return may never require the previous line:

source parsing

type Line_Ptr_Type is private;

This pointer type is used to reference source line body in the procedure Get_Line.

type Location_Type is private;

Objects of this type are used to identify a contiguous slice of the source. This can be any part of the source, if multiple lines are supported, then Location_Type should allow to specify several source lines.

function End_Of (Code : Source_Type) return Boolean;

This function returns true at the source end.

function Get_Line (Code : Source_Type) return String;

This function gets the current source code line. It remains valid until the first call to Next_Line. End_Error is propagated when end source was reached either because the source is empty or because of a call to Next_Line before.

procedure Get_Line
          (  Code    : Source_Type;
             Line    : out Line_Ptr_Type;
             Pointer : out Integer;
             Last    : out Integer
          );

This procedure is combines Get_Line and Get_Pointer. It returns a pointer to the buffer containing the current source code line (the parameter Line), the current cursor position (the parameter Pointer) in that buffer and the position of the last character in the buffer (the parameter Last). It might be more efficient than the function Get_Line if the compiler optimization is not great and it might happen that renaming of a slice returned from Get_Line could result in copying its content. The pointer returned may refer to a string longer that the current line. Usually the implementation of a source would hold an internal string buffer. Line might point to it, so that Line (Pointer..Last) would be the rest of the current line, yet to parse. The implementation shall ensure equivalence of the value returned in the Pointer parameter to the one returned by the function Get_Pointer and accepted by Set_Pointer. Usually it is achieved when the function Get_Line returns a slice of the buffer returned by the procedure Get_Line. Note that in Ada string slicing does not shift the lower bound of the result to 1. Thus it is safe to use plain slicing there.  Like the function, the procedure Get_Line raises End_Error at the source end or else when the source is empty.

function Get_Pointer (Code : Source_Type) return Integer;

This function gets the current cursor. The result is an index in the current line which would be returned by Get_Line. It is in the range Line'First..Line'Last+1 provided that Line is the value returned by Get_Line. The character pointed by Get_Pointer is the first one to parse. The characters before are the recognized ones. At the source end, when Get_Line would raise End_Error, 1 is the result.

function Get_Backup_Pointer (Code : Source_Type)
   return Integer;

This function returns the saved cursor. It is one to which Reset_Pointer would return. At the source end, when Get_Line would raise End_Error, 1 is the result. The slice of the current line starting from the result of Get_Backup_Pointer and ending in the character before one pointed by Get_Pointer is usually the last recognized token.

procedure Next_Line (Code : in out Source_Type);

This procedure advances to the next source line. After a successful completion Get_Line can be used to access the newly read source line. Both cursors are set to Get_Line'First. So when the line is not empty Get_Pointer will return the index of the first character in the new source line. Data_Error is propagated on I/O errors. End_Error is propagated when the source end is reached.

procedure Reset_Pointer (Code : in out Source_Type);

This procedure moves the second cursor back to the first cursor, so that Get_Pointer would return the value of Get_Backup_Pointer. The depth of the "unget" need not to be deeper than 1. Consequent calls to Reset_Pointer may have no effect. It is also not required to implement a return to the previous line.

procedure Set_Pointer
          (  Code    : in out Source_Type;
             Pointer : Integer
          );

This procedure is used to move the cursors forward. The parameter Pointer is the new position of the second cursor, it should be in the range between the position returned by Get_Pointer and the position following the last character of the current line, i.e. Get_Line (Code)'Last + 1. At the source end when Get_Line would raise End_Error, the only valid value to set is 1. Otherwise Layout_Error is propagated. The first cursor is moved to the old position of the second one. The following small example illustrates an implementation of a routine to skip spaces in the source line:

procedure Skip (Code : in out Source_Type) is
   Line    : String renames Get_Line (Code);
   Pointer : Integer := Get_Pointer (Code);
begin
   while Pointer <= Line'Last and then Line (Pointer) = ' ' loop
      Pointer := Pointer + 1;
   end loop;
   Set_Pointer (Code, Pointer);
end Skip;

The procedure Skip could be implemented using the procedure Get_Line as follows:

procedure Skip (Code : in out Source_Type) is
   Line    : Line_Ptr_Type;
   Pointer : Integer;
   Last    : Integer;
begin
   Get_Line (Code, Line, Pointer, Last);
   while Pointer <= Last and then Line (Pointer) = ' ' loop
      Pointer := Pointer + 1;
   end loop;
   Set_Pointer (Code, Pointer);
end Skip;

function Link (Code : Source_Type) return Location_Type;

This function gets the source code location between two cursors. The second cursor is one returned by Get_Pointer. The first cursor is the previous value of the second one returned by Get_Backup_Pointer. The slice in between is usually the last recognized lexical token. It includes the character pointed by the first cursor, and does not one pointed by the second one. Empty slices are allowed, so Link should never fail even at the end of a source. Should Link (Code) called immediately after a call to Skip above, it would return a location identifying the blank slice matched by Skip in the source code line.

function Image (Link : Location_Type) return String;

This function returns a text description of a location. The result is a string;

function "&" (Left, Right : Location_Type)
   return Location_Type;

This function is used to combine two, usually adjacent a source code locations. The result is a consecutive code fragment containing positions from both Left and Right locations. For example if Left and Right are locations of "(" and ")" then the result is everything in the brackets including the brackets.

Various generic child packages provide parsing facilities to match a thing in a source and move the cursor beyond it:

13.4.1. Source cursors I/O

The child package Parsers.Generic_Source.Text_IO can be used for debugging. It provides:

procedure Put_Line
          (  File        : File_Type;
             Code        : Source_Type;
             Expand_Tabs : Boolean := False
          );
procedure Put_Line
          (  Code        : Source_Type;
             Expand_Tabs : Boolean := False
          );

These procedures output the current source code line following current source cursors. The output might look like:

123.0 + ( Value - 1)
          ^^^^^|

The parameter File is the text file to write. It is the standard output if missing. Code is the source code. The parameter Expand_Tabs when true forms the second output line in accordance with the tabulations expanded in the first line. The tabulations of the first line are not explicitly expanded, but output as-is.

The package Parsers.Multiline_Source.Location_Text_IO is an instance of Parsers.Generic_Source.Text_IO for the multi-line source provided in the package Parsers.Multiline_Source.

13.4.2. Procedures to skip blanks

There are three child procedures of Parsers.Generic_Source which can be used to skip the following blanks and comments:

generic
procedure Parsers.Generic_Source.Get_Blank
          (  Code   : in out Source_Type;
             Got_It : out Boolean
          );

This procedure skips spaces, tabulations (HT), line feeds (LF), carriage returns (CR), vertical tabulations (VT), form feeds (FF) and requests new source lines when necessary. Upon completion Got_It is set to true if the source end is not yet reached. Otherwise it is false.

generic
procedure Parsers.Generic_Source.Get_Ada_Blank
          (  Code   : in out Source_Type;
             Got_It : out Boolean
          );

This procedure skips Ada 95 comments, spaces, HT, LF, CR, VT, FF and requests new source lines when necessary. Upon completion Got_It is set to true if the source end is not yet reached. Otherwise it is false. Beware that according to Ada 95 RM 2.2 comment ends either at the physical line end or in either of format effectors: LF, CR, VT, FF. This may lead to surprises when format effectors appear in the middle of what the operating system counts for a single line.

generic
procedure Parsers.Generic_Source.Get_Ada_2005_Blank
          (  Code   : in out Source_Type;
             Got_It : out Boolean
          );

This procedure skips Ada 2005 comments and blanks. It is similar to Get_Ada_Blank except that UTF-8 encoded space separators are also considered blank.

generic
procedure Parsers.Generic_Source.Get_Cpp_Blank
          (  Code     : in out Source_Type;
             Got_It   : out Boolean;
             Error    : out Boolean;
             Error_At : out Location_Type
          );

This procedure skips C++ comments, spaces, HT, LF, CR, VT, FF and requests new source lines when necessary. A C++ comment either starts with // (double forward slash) and continues to the end of the current line or it does with /* (forward slash, asterisk) and continues to the first appearance of closing */. In the latter case nested /*..*/ comments are not recognized. Upon completion Got_It is set to true if the source end is not yet reached. Otherwise it is false. Error is set to true when no closing */ is found before the source end. In this case Error_At contains the location of /* in the source. Otherwise, Error is false and Error_At is not defined.

13.4.3. Procedure to skip text

There are two child procedures of Parsers.Generic_Source which can be used to skip a text in the source:

generic
procedure Parsers.Generic_Source.Get_Text
          (  Code   : in out Source_Type;
             Text   : String;
             Got_It : out Boolean;
             Map    : Character_Mapping := Identity 
          );
generic

procedure Parsers.Generic_Source.Get_UTF8_Text
          (  Code   : in out Source_Type;
             Text   : String;
             Got_It : out Boolean;
             Map    : Unicode_Mapping := Identity 
          );

The procedure Get_Text is used for dealing with Latin-1 encoded sources. The procedure Get_UTF8_Text is used with UTF-8 sources. Upon completion Got_It is set to true if Text was recognized and skipped. Otherwise it is false. It can be used for creating simple recursively descending parsers. The parameter Map specifies the character equivalence. A character in the source and in Text are equivalent when they are equivalent in Map. The default value considers all characters distinct. To have case-insensitive match one can use Ada.Strings.Maps.Constants.Lower_Case_Map with Get_Text, and.Strings_Edit.UTF8.Maps.Constants.Lower_Case_Map with Get_UTF8_Text. Syntax_Error is propagated from Get_UTF8_Text when source is not properly encoded UTF-8.

13.4.4. Matching keywords

When writing recursive descent parsers it is common to match the source against a list of keywords. The child procedure Get_Token of Parsers.Generic_Source can be used for this purpose. It has a generic formal parameter Tokens which is an instance of the package Tables:

generic
   with package
Tokens is new Tables (<>);
procedure
Parsers.Generic_Source.Get_Token
          (  Code   : in out Source_Type;
             Folder : Tokens.Table'Class;
             Token  : out Tokens.Tag;
             Got_It : out Boolean
          );

The procedure matches the source Code against the table Folder. If a token from Folder is matched, then it is skipped in Code, the value associated with it is stored in Token and Got_It is set to true. Otherwise Got_It is set to false, and Token is not changed. Note that Folder can be a descendant of the table type defined in Tables. This means that one can also use case-insensitive tables from the package Tables.Names.

When keywords to match are plain case-insensitive words, the generic child package Keywords can be used instead of Get_Token. An enumeration type is the generic parameter of the package. The literals of the type are the keywords to match:

generic
   type
Keyword is (<>);
package Parsers.Generic_Source.Keywords is
   ...

The package provides the procedure:

procedure Get
          (  Code   : in out Source_Type;
             Token  : out Keyword;
             Got_It : out Boolean
          );

This procedure matches a keyword in Code. Matching is case-insensitive. When matched the keyword value is set into Token and Got_It is set to true. The source cursor is then advanced behind the text matched. The longest possible token is always matched. When no token matches the source Got_It is set to false. The following code sample illustrates usage of the package:

with Parsers.Multiline_Source; -- Multiline sources
with Parsers.Generic_Source.Keywords;
...
   type Color_Type is (Red, Blue, White, Green);
   package Colors is
      new
Parsers.Multiline_Source.Code.Keywords (Color_Type);
   ...
   Color  : Color_Type;
   Got_It : Boolean;
begin
   ...
   loop -- Parsing loop
      ...
      Colors.Get (Code, Color, Got_It);
      if not Got_It then
         ... -- This is probably a syntax error
      else
         case
Color is
            when
Red  => -- "red" was matched
               ...
            when Blue => -- "blue" was matched
      ...

This package has a limited use, because many words are reserved in Ada, and thus cannot be enumeration literals.

13.4.5. Parsing XPM files

This is a useful example of designing parsers unrelated to infix expressions, based solely on sources. The source code is located in the subdirectory xpm. It provides a set of types to deal with XPM image format. The package is generic:

generic
package
Parsers.Generic_Source.XPM is
   ...

It can be instantiated for any type sources, but usually it makes sense for multi-line sources only. The is an instance of the package for this case: Parsers.Multiline_Source.XPM.

The generic package provides three subprograms for parsing XPM files. An XPM file is basically a C program containing data structures of an image. The source of it is usually parsed this way:

declare
   Header : Descriptor         := Get (Source);
   Map    : Color_Tables.Table := Get (Source, Header);
   Image  : Pixel_Buffer       := Get (Source, Header, Map);
begin
   ... --
The image can be used here

The package defines the following data types and subroutines:

type Descriptor
     (  Has_Hotspot : Boolean;
        Length      : Positive
     )  is
record
   Name       : String (1..Length);
   Width      : Positive;
   Height     : Positive;
   Pixel_Size : Positive;
   Map_Size   : Positive;
   Extended   : Boolean;
   case
Has_Hotspot is
      when
True =>
         X_Hotspot : Natural;
         Y_Hotspot : Natural;
      when
False =>
         null
;
   end case
;
end record
;

The descriptor holds the information about an XPM image:

function Get (Code : access Source_Type) return Descriptor;

This function matches XPM descriptor in Code and returns the value of. Syntax_Error is propagated on syntax errors. Other exceptions are related to the source access.

type RGB_Color is range 0..2**24;
Transparent : constant RGB_Color := RGB_Color'Last;
package Color_Tables is new Tables (RGB_Color);

The color values are encoded as RGB, big-endian. For example, Red is 16#FF0000#. The value 2**24 is used for the transparent color. The type Color_Table.Table is a mapping from String to RGB_Color used to represent color maps. It is an instance of Tables.

function Get
         (  Code   : access Source_Type;
            Header : Descriptor
         )  return Color_Tables.Table;

This function matches XPM color map in Code and returns the value of. Header is a descriptor obtained by a call to Get immediately before. Syntax_Error is propagated on syntax errors. Other exceptions are related to the source access.

type Pixel_Buffer is
   array
(Positive range <>, Positive range <>)
      of RGB_Color;

This type is used to represent the image pixels as row x column.

function Get
         (  Code   : access Source_Type;
            Header : Descriptor;
            Map    : Color_Tables.Table
         )  return Pixel_Buffer;

This function matches XPM image in Code and returns the value of. Header is a descriptor obtained by a call to Get and Map is a color map obtained by a call to Get. Syntax_Error is propagated on syntax errors. Other exceptions are related to the source access.

13.4.6. String sources

The package Parsers.String_Source provides an implementation of code source based on standard strings. The package is non-generic. It instantiates Parsers.Generic_Source under the name Code. So the package Parsers.String_Source.Code can be used everywhere an instance of Parsers.Generic_Source is required. Additionally the package defines:

type Location is record
   From   : Integer;
   Length : Natural;
end record;

This is the type used for string source locations.

type Source (Text : access String) is limited record
   Pointer : Integer := Text'First;
   Last    : Integer := Text'First;
end record;

This is the type of a string source. The discriminant Text points to the string being parsed.

13.4.7. Multi-line sources

The package Parsers.Multiline_Source provides an implementation of code sources consisting of several lines. The package is non-generic. It instantiates Parsers.Generic_Source under the name Code. So the package Parsers.Multiline_Source.Code can be used everywhere an instance of Parsers.Generic_Source is required. The package defines an abstract base type Source which should be concretized by overriding its abstract operations. The package defines:

type Line_Number is new Natural;

The source line numbers.

type Position is record
   Line   : Line_Number;
   Column : Integer;
end record;

The source position.

function "<" (Left, Right : Position) return Boolean;

The source positions are comparable using both "=" and "<" .

type Location is record
   First : Position;
   Next  : Position;
end record;

The source locations are specified by the first character position and the position of the first character next to location.

type Source is
   abstract new
Ada.Finalization.Limited_Controlled with
record

   Buffer  : String_Ptr;
   Line    : Line_Number := 0;
   Length  : Natural;
   Pointer : Integer;
   Last    : Integer;
end record;

Here the fields are:

The field Buffer points to a string, which is used to keep the current source line. The constructor allocates the buffer of some reasonable size. When a new line is requested the buffer can be replaced by a larger one if necessary.

procedure Finalize (Code : in out Source);

The destructor deallocates the buffer.

procedure Initialize (Code : in out Source);

The constructor creates the buffer.

procedure Get_Line (Code : in out Source) is abstract;

This is an abstract procedure to be overridden. An implementation should read a complete next line into Code.Buffer.all. It may reallocate the buffer if necessary. After a successful completion Code.Buffer should point to a buffer containing the line and Code.Length should be the line length. The rest of the buffer is ignored. End_Error is propagated if no more lines available. Other exceptions can be used on I/O error.

function Get_Location
         (  Message : String;
            Prefix  : String := "at "
         )  return Location;

This function searches for a location image in an error message string. The image is searched backwards for an appearance of Prefix. If an image does not follow Prefix search continues. The result is the location decoded according to the format used by Image. If no image found the result is ((0,0), (0,0)).

procedure Skip (Code : in out Source'Class; Link : Location);

This procedure advances the source Code to the location Link, so that the result of Link (Code) would equal to the value of the parameter Link. Layout_Error is propagated when the source is beyond the first position of Link. It is also propagated when some parts of Link do not belong to the source Code.

The following sample code illustrates use of Skip and Get_Location for error output:. The procedure takes error occurrence and the source file name. Then it opens the file, moves to the error location obtained and prints the location together with the error message.

with Ada.Text_IO;               use Ada.Text_IO;
with
Ada.Exceptions;            use Ada.Exceptions;
with
Parsers.Multiline_Source;  use Parsers.Multiline_Source;

with
Parsers.Multiline_Source.Location_Text_IO;
use 
Parsers.Multiline_Source.Location_Text_IO;

procedure
Show_Error (Error : Erroc_Occurrence; File_Name : String) is
   File : aliased File_Type;
begin
   Open (File, In_File, File_Name);
   declare
      Code : Parsers.Multiline_Source.Text_IO.Source (File'Access);
   begin
      Skip (Code, Get_Location (Exception_Message (Error)));
      Put_Line (Code);
   exception
      when others
=>
         null;
   end;
   Close (File);
   Put_Line ("Error : " & Exception_Message (Error));
exception
   when others
=>
      Close (File);
      Put_Line ("Error : " & Exception_Message (Error));
end Show_Error;

13.4.8. Text file sources

The package Parsers.Multiline_Source.Text_IO provides sources based on text files. It declares the type Source:

type Source (File : access File_Type) is
   new Multiline_Source.Source with private;

The discriminant File points to the file to read. The type File_Type is defined in Ada.Text_IO. See also Parsers.Multiline_Source.Latin1_Text_IO and Parsers.Multiline_Source.Wide_Text_IO packages used for handling Latin-1 and wide (UCS-2) encoded files as with recoding into UTF-8.

13.4.9. Standard input source

The package Parsers.Multiline_Source.Standard_Input provides sources based on the standard input file. It declares the type Source:

type Source is new Multiline_Source.Source with private;

13.4.10. Latin-1 and wide text file sources

The package Parsers.Multiline_Source.Latin1_Text_IO provides sources based on latin-1 text files. It declares the type Source:

type Source (File : access File_Type) is
   new Multiline_Source.Source with private;

The discriminant File points to the file to read. The type File_Type is defined in Ada.Text_IO. The package is used to read text files encoded in Latin-1, when the parser is designed for UTF-8. Otherwise, Latin-1 files can also be read using Parsers.Multiline_Source.Text_IO. The implementation recodes the input into UTF-8, so that the parser need not to care about the actual encoding. Note that the source position is translated correspondingly, i.e. Pointer would refer to the source line octet offset rather than to the corresponding character position.

The package Parsers.Multiline_Source.Wide_Text_IO provides sources based on wide text files. It declares the type Source:

type Source (File : access File_Type) is
   new Multiline_Source.Source with private;

The discriminant File points to the file to read. The type File_Type is defined in Ada.Wide_Text_IO. The package is used to read text files encoded in a way that requires wide text I/O. Usually it is UCS-2 files. The implementation recodes the input into UTF-8, so that the parser need not to care about the actual encoding. Note that the source position is translated correspondingly, i.e. Pointer would refer to the source line octet offset rather than to the corresponding character position.

13.4.11. Stream sources

The package Parsers.Multiline_Source.Stream_IO provides sources based on streams. The stream is read using the Character'Read stream attribute. The read characters are classified into the data and delimiter characters. The delimiter categories are defined by the type:

type Delimiter is (Line_End, Line_Trailer, Text_End);

Here the categories of the delimiters are:

Additionally, the End_Error exception, when propagated by Character'Read, acts as if a Text_End character were read. The package Delimiter_Map

package Delimiter_Maps is new Generic_Map (Character, Delimiter);

provides maps of characters to the delimiter categories.

function Default_Delimiters return Map;

This function returns a mapping of default delimiters, which should be suitable for most cases. It contains the following mappings:

 The type Source is declared as

type Source (Stream : access Root_Stream_Type'Class) is
   new Multiline_Source.Source with
record
   Delimiters : Map := Default_Delimiters;
end record
;

The discriminant Stream is the stream to read from. The component Delimiters specifies the delimiters to use.

Notes:
  • If the component Delimiters need to be changed, this has to be done before Initialize is called on the instance of Source. The reason for that is that Initialize caches the first source line, so it requires Delimiters properly set. In Ada 2005 you can use an aggregate to initialize Delimiters to another value. This initialization occurs before Initialize. In Ada 95, where limited aggregates are not allowed, you will have to override Initialize and set Delimiters there, before you call to the parent's type Initialize.
  • If the String_Stream from the package Strings_Edit.Streams is used the stream must be set before object is declared because the first line read ahead upon object initialization. Here is the code sample that illustrates the proper use of string stream:
declare
   Text : aliased Strings_Edit.Streams.String_Stream (1024); -- Declare string stream object
begin

   Set (Text, "abcd"); -- Set a string into the stream
   declare
     
Input : aliased Parsers.Multiline_Source.Source (Text'Access); -- Declare source
   begin
     
-- Here the source input can be used
   end
;
end
;

[Back][TOC][Next]

13.5. Tokens

The expression tokens are operations and operands. The generic package Parsers.Generic_Token defines the token types:

generic
   type
Argument_Type  is private;
   type Operation_Type is private;
   type Priority_Type  is private;
   with package Sources is new Generic_Source (<>);
   with function "and" (Left, Right : Operation_Type)
      return Boolean is <>;
   with function Is_Commutative (Left, Right : Operation_Type)
      return Boolean is <>;
   with function Is_Inverse (Binary_Operator : Operation_Type)
      return Boolean is <>;
   with function Group_Inverse (Binary_Operator : Operation_Type)
      return Operation_Type is <>;
   with function "<" (Left, Right : Priority_Type)
      return Boolean is <>;
package Parsers.Generic_Token is ...

The parameters of the package defines the operations and the operands to use:

The package provides implementation of the following data structures used during expression parsing:

package Arguments is
   new
Generic_Argument (Argument_Token);

package Descriptors is
   new
Generic_Operation (Operation_Token, Priority_Type);

package Vocabulary is new Tables (Table_Token);

Token tables are used by parser to recognize operation symbols in the source. In accordance with three expression contexts there are at least tree token tables: the table of prefixes, the table of infixes and the table of postfixes. Each table contains the tokens which may appear in the corresonding context.

To make these instantiations the package defines the following types:

type Argument_Token is record
   Value    : Argument_Type;
   Location : Location_Type;
end record;

This type describes an appearance of an argument (operand) in the source. The field Value identifies the argument. The field Location is the argument location.

type Operation_Token is record
   Operation : Operation_Type;
   Location  : Location_Type;
end record;

This type describes an appearance of an operation in the source. Operation identifies the operation, Location is the operation location.

type Table_Token (Class : Token_Class := Operator) is record
   Operation : Operation_Type;
   case Class is
      when Operator =>
         Left  : Priority_Type;
         Right : Priority_Type;
      when Index | Semicolon_Class'Range =>
         Priority : Priority_Type;
      when Bracket | Comma | Ligature | Modifier_Class'Range =>
         null;
   end case;
end record;

This type describes the tokens associated with expression operations to recognize in the source. The discriminant Class specifies the class of the operation. The field Operation identifies the operation. Additional fields determine the operation priorities, if applied. The following operations on tables of Table_Table token can be used for filling the tables:

procedure Add_Operator
          (  Table    : in out Vocabulary.Table'Class;
             Name     : String;
             Operator : Operation_Type;
             Left     : Priority_Type;
             Right    : Priority_Type
          );

This procedure is used to add an operator to a token table. It can be either a prefix unary operator for a table of prefixes, or a binary infix operator for an table of infixes or a postfix unary operator for a table of postfixes. The parameter Table is the corresponding token table. Name is the operator name. Note that the same operator can be specified under different names. Operator is the operation associated with the name. Left and Right are the operator priorities. Constraint_Error is propagated on an incorrectly spelled name, if spelling is checked (see Table). Name_Error is propagated if the name is already in the table.

procedure Add_Bracket
          (  Table   : in out Vocabulary.Table'Class;
             Name    : String;
             Bracket : Operation_Type
          );

This procedure is used to add a left order bracket or one of an aggregate to a table of prefixes. It can also be used to add a right bracket of any kind to a table of postfixes. The parameter Table is the corresponding token table. Name is the bracket name. Note that the same bracket can be specified under different names. Bracket is the operation associated with the name. Constraint_Error is propagated on an incorrectly spelled name. Name_Error is propagated if the name is already in the table.

procedure Add_Comma
          (  Table : in out Vocabulary.Table'Class;
             Name  : String;
             Comma : Operation_Type
          );

This procedure is used to add a comma to a table of infixes. The parameter Table is the table. Name is the comma  name. The same comma can be specified under different names. Comma  is the operation associated with the name. Constraint_Error is propagated on an incorrectly spelled name. Name_Error is propagated if the name is already in the table.

procedure Add_Index
          (  Table : in out Vocabulary.Table'Class;
             Name  : String;
             Index : Operation_Type;
             Left  : Priority_Type
          );

This procedure is used to add a left index bracket to a table of infixes. The parameter Table is the table. Name is the name of the left array index or function call bracket. Note that the same bracket can be specified under different names. Index is the operation associated with the name. Left is the left priority of the bracket. Constraint_Error is propagated on an incorrectly spelled name. Name_Error is propagated if the name is already in the table.

procedure Add_Ligature
          (  Table    : in out Vocabulary.Table'Class;
             Name     : String;
             Ligature : Operation_Type
          );

This procedure is used to add a ligature to a table of infixes. The parameter Table is the table. Name is the name of the ligature. Note that the same ligature can be specified under different names. Ligature is the operation associated with the name. Constraint_Error is propagated on an incorrectly spelled name. Name_Error is propagated if the name is already in the table.

procedure Add_Postmodifier
          (  Table    : in out Vocabulary.Table'Class;
             Name     : String;
             Modifier : Operation_Type
          );

This procedure is used to add a postmodifier to a table. The parameter Table is the table. Name is the name of the modifier. Modifier is the operation associated with the name. Constraint_Error is propagated on an incorrectly spelled name. Name_Error is propagated if the name is already in the table.

Modifiers cause call to On_Postmodifier handler when recognized.

A postmodifier added to the table of infixes is always discarded, because an infix operation is mandatory to appear after an operand. This has the effect of stopping parsing at the modifier, which can be utilized when there are reserved keywords used to bound expressions.

A postmodifier added to a prefix or postfix table may appear several times. This behaviour may require special handling. For example, let "in" be a postmodifier for "is". Then "x is in y" and "x is in in y" will all be legal. To prevent this, one should change the operation to an equivalent once upon a call to On_Postmodifier, so that by the next call to it, one could detect that "in" was already applied and discard the second "in".

Note that a postmodifier cannot be used to modify commas because they never visit the operations stack.

procedure Add_Premodifier
          (  Table    : in out Vocabulary.Table'Class;
             Name     : String;
             Modifier : Operation_Type
          );

This procedure is used to add a premodifier either to a table of prefixes or to a table of postfixes. The premodifier when recognized causes a call to On_Premodifier when the operation following it appears. If the latter does not, On_Missing_Operation is called. Note that a premodifier cannot be returned back, thus a dangling premodifier is usually a severe error if it cannot be ignored. So it is preferable to use postmodifiers over premodifiers wherever possible. Constraint_Error is propagated on an incorrectly spelled name. Name_Error is propagated if the name is already in the table.

procedure Add_Semicolon
          (  Table     : in out Vocabulary.Table'Class;
             Name      : String;
             Semicolon : Operation_Type;
             Class     : Semicolon_Class;
             Priority  : Priority_Type
          );

This procedure is used to add a semicolon to a table of infixes. The parameter Table is the table. Name is the semicolon  name. The same semicolon can be specified under different names. Semicolon is the operation associated with the name, argument sublists separated by the semicolon will be merged by this operation. The parameter Class specifies the semicolon type. Constraint_Error is propagated on an incorrectly spelled name. Name_Error is propagated if the name is already in the table. When a sublist obtains all it is elements Enclose is called with the parameters indicating left index bracket, bracket or semicolon enclosing the sublist. Among the operations of Enclose at least one is a semicolon. The parameter Priority control the association priority of the separator among other separators. It is the left association priority when Class is Sublist_Close or Sublist_Separator. It is the right priority if Class is Sublist_Open or Sublist_Separator.

Additionally the package defines:

function Link (List : Arguments.Frame) return Location_Type;

This function merges the locations of all arguments in List. The result is a minimal contiguous location containing locations of all arguments from List.

13.5.1. Table-driven lexers

The child generic package Parsers.Generic_Token.Generic_Token_Lexer an abstract type for table driven infix expression lexers:

generic
   type Argument_Stack is new Arguments.Stack with private;
   with package Operations is new Descriptors.Generic_Stack (<>);
   type Operation_Stack is abstract new Operations.Stack with private;
package Parsers.Generic_Token.Generic_Token_Lexer is ...

The package has the following formal parameters:

The package instantiates Parsers.Generic_Lexer to provide lexers operating on the Argument_Stack and Operation_Stack:

package Implementation is
   new Parsers.Generic_Lexer
       (  Arguments       => Arguments,
          Descriptors     => Descriptors,
          Operations      => Operations,
          Argument_Stack  => Argument_Stack,
          Operation_Stack => Operation_Stack,
          Sources         => Sources
       );

The obtained lexer type is then extended:

type Lexer
     (  Prefixes  : access Vocabulary.Table'Class;
        Infixes   : access Vocabulary.Table'Class;
        Postfixes : access Vocabulary.Table'Class
     )  is abstract new Implementation.Lexer with private;

The type Lexer has the following discriminants:

A type derived from Lexer has to implement the following abstract subroutines defined for the base type in Parsers.Generic_Lexer:

The following error handlers can be overridden if other behavior required:

procedure Parse
          (  Context : in out Implementation.Lexer'Class;
             Code    : in out Source_Type;
             Result  : out Argument_Token
          )  renames Implementation.Parse;

This class-wide procedure renames Parsers.Generic_Lexer.Parse. Upon successful completion Result is one of the expression. Note that Result is of Argument_Token type. So it contains both the expression result and its location, which is usually the expression location. The state of Code indicates how far the expression parsing advanced even in case of an exception. Parse is recursive-call safe as long as implementations of the abstract operations do not change Context and Code in an inappropriate way.

13.5.2. Table-driven segmented lexers

The child generic package Parsers.Generic_Token.Segmented_Lexer provides table driven infix expression lexers based on segmented stack implementations:

generic
   Argument_Frame_Segment_Size : Positive := 128;
   Argument_Frame_Minimal_Size : Positive := 64;
   Argument_Frame_Increment    : Natural  := 50;
   Argument_Stub_Minimal_Size  : Positive := 64;
   Argument_Stub_Increment     : Natural  := 50;
   Operation_Segment_Size      : Positive := 128;
   Operation_Minimal_Size      : Positive := 64;
   Operation_Increment         : Natural  := 50;
package Parsers.Generic_Token.Segmented_Lexer is ...

The formal parameters Argument_* control argument stack allocation policy, see Parsers.Generic_Argument.Segmented_Stack. The formal parameters Operation_* control operation stack allocation policy, see Parsers.Generic_Operation.Segmented_Stack.

The package instantiates Parsers.Generic_Token.Generic_Lexer under the name Token_Lexer. The type Lexer defined there is used as an abstract base:

subtype Lexer is Token_Lexer.Lexer;

A type derived from Lexer has to implement the following abstract subroutines defined for the base type in Parsers.Generic_Lexer:

procedure Parse
          (  Context : in out Token_Lexer.Implementation.Lexer'Class;
             Code    : in out Source_Type;
             Result  : out Argument_Token
          )  renames Token_Lexer.Implementation.Parse;

This class-wide procedure renames Parsers.Generic_Lexer.Parse. Upon successful completion Result is one of the expression. Note that Result is of Argument_Token type. So it contains both the expression result and its location, which is usually the expression location. The state of Code indicates how far the expression parsing advanced even in case of an exception. Parse is recursive-call safe as long as implementations of the abstract operations do not change Context and Code in an inappropriate way.

[Back][TOC][Next]

13.6. Lexers

The package Parsers.Generic_Lexer provides abstract infix expression lexer. A lexer scans the source for an expression. It stops scanning at the expression end. As it scans the source it uses two stacks to arrange the operands and operations it recognizes. Operands are stored on the argument stack, operations are pushed onto the operation stack. To recognize the expression tokens abstract subroutines are used to be implemented by concrete derived types.

generic
   with package
Arguments is new Generic_Argument (<>);
   type Argument_Stack is new Arguments.Stack with private;
   with package Descriptors is new Generic_Operation (<>);
   with package Operations is new Descriptors.Generic_Stack (<>);
   type Operation_Stack is abstract new Operations.Stack with private;
   with package Sources is new Generic_Source (<>);
package Parsers.Generic_Lexer is ...

The package generic parameters:

The package defines the abstract type Lexer:

type Lexer is abstract new Operation_Stack with private;

and the type of lexical tokens used to communicate with lexical callbacks:

type Lexical_Token (Class : Token_Class := Operator) is record
   Operation : Operation_Type;
   case Class is
      when Operator =>
         Left  : Priority_Type;
         Right : Priority_Type;
      when Index | Semicolon_Class'Range =>
         Priority : Priority_Type;
      when Bracket | Comma | Ligature | Modifier_Class'Range =>
         null;
   end case;
end record;

Class-wide operations:

procedure Parse
          (  Context : in out Lexer'Class;
             Code    : in out Source_Type;
             Result  : out Argument_Type
          );

is used to scan the source Code. Upon successful completion Result is one of the expression. In any outcome the source cursor indicates how far the expression parsing has managed to proceed. Parse is recursive-call safe as long as implementations of the abstract operations do not change Context and Code in an inappropriate way. It means that an implementation of an operation may in turn call Parse to get a subexpression from source if that necessary.

Abstract primitive operations: A type derived from Lexer has to implement the following abstract operations:

function Call
         (  Context   : access Lexer;
            Operation : Operation_Type;
            List      : Frame
         )  return Argument_Type is abstract;

This function is called to execute an operator when all its arguments become known. Ligatures and semicolons are also executed by making a call to this procedure. The parameter Operation identifies the operator being called. List is the list of the arguments. The first element of List is the first argument for Operation. The result is one of the operation. Any exception raised in Call will abort parsing and propagate out of Parse. Note that binary commutative operations for which Is_Commutative returns true are optimized, may have List larger than of just two arguments. For example: for a commutative "+" the expression A+B+C will result in one call "+"(A,B,C) instead of two: "+"("+"(A,B),C). Note that this function is called from the overriding of Call inherited with Operation_Stack. It can be overridden to manipulate the arguments and operations stacks directly.

function Enclose
         (  Context : access Lexer;
            Left    : Operation_Type;
            Right   : Operation_Type;
            List    : Frame
         )  return Argument_Type is abstract;

This procedure is called to execute brackets. Brackets could be order, aggregate, array index or function calls. In the latter two cases the first argument in List is the array to be indexed or the function to be called. The parameter Left identifies the left bracket. The parameter Right does the right one. The result is one of the bracket operation. Any exception raised in Enclose will abort parsing and propagate out of Parse. Note that this function is called from the overriding of Enclose inherited with Operation_Stack. It can be overridden to manipulate the arguments and operations stacks directly.

procedure Get_Blank
          (  Context : in out Lexer;
             Code    : in out Source_Type;
             Got_It  : out Boolean
          )  is abstract;

An implementation should skip everything till the next valid lexeme in the source Code. It starts from the current source position (see Get_Line and Get_Pointer) and advances it to the first non-blank character (see Set_Pointer). The parameter Got_It is set to false when the end of expression reached. This could be the end of file or a reserved keyword. Usually Get_Blank skips spaces, tabs, linefeeds and comments. Get_Blank may raise an exception to be propagated out of Parse on an error, like unclosed comment etc. There are child packages implementing different variants of Get_Blank: see Parsers.Generic_Lexer.Blanks / Ada_Blanks / Cpp_Blanks.

procedure Get_Infix
          (  Context : in out Lexer;
             Code    : in out Source_Type;
             Token   : out Lexical_Token;
             Got_It  : out Boolean
          )  is abstract;

An implementation should recognize a valid infix token and skip it in the source Code by advancing the source cursor (see Set_Pointer). Got_It indicates success. When Got_It is set to true, Token contains a valid infix token. That is either of:

When Got_It is false, it means that no infix operation was detected. Get_Infix may raise an exception to be propagated out of Parse on an unrecoverable error. Lexer automatically processes assumed infix operations. When it is necessary to parse expressions like 5a+1, then the multiplication is an implied operator. Lexer recognizes this case when the source pointers are equal. Implied operators are discarded at the expression end without call to On_Missing_Operand.

procedure Get_Operand
          (  Context  : in out Lexer;
             Code     : in out Source_Type;
             Argument : out Argument_Type;
             Got_It   : out Boolean
          )  is abstract;

An implementation should recognize a valid operand token and skip it in the source Code. Got_It indicates success. If Got_It is true then Argument contains or references to the operand such as literal, name etc. Otherwise, it means that no operand was recognized in the source. Get_Operand may raise an exception to be propagated out of Parse on an unrecoverable error. Note that syntax errors in operands should not necessarily be fatal. Argument can be set into a special value indicating a syntactically wrong operand, which would allow to continue parsing.

procedure Get_Postfix
          (  Context : in out Lexer;
             Code    : in out Source_Type;
             Token   : out Lexical_Token;
             Got_It  : out Boolean
          )  is abstract;

An implementation should recognize a valid postfix token and skip it in the source Code. Got_It indicates success. When Got_It is true then Token contains a valid postfix token. That is either of:

When Got_It is false, it means that no postfix operation was detected. Get_Postfix may raise an exception to be propagated out of Parse on an unrecoverable error.

procedure Get_Prefix
          (  Context : in out Lexer;
             Code    : in out Source_Type;
             Token   : out Lexical_Token;
             Got_It  : out Boolean
          )  is abstract;

An implementation should recognize a valid prefix token and skip it in the source Code. Got_It indicates success. When Got_It is true then Token contains a valid prefix token. That is either of:

When Got_It is false, it means that no postfix operation was detected. Get_Prefix may raise an exception to be propagated out of Parse on an unrecoverable error.

The following procedures are used for error handling. They are called from Parse to handle an exceptional state detected during expression parsing.

procedure On_Association_Error
          (  Context : in out Lexer;
             Code    : in out Source_Type;
             Left    : in out Operation_Type;
             Right   : in out Operation_Type
          )  is abstract;

This procedure is called when two operators sharing or associated in an argument are incompatible. The handler may modify any of the parameters Left and Right to make them compatible. In this case upon return the operation Right will be pushed onto the operation stack again with all association checks suppressed. Alternatively it may raise an exception which would then abort parsing and propagate out of Parse.

procedure On_Missing_Operand
          (  Context   : in out Lexer;
             Code      : in out Source_Type;
           [ Operation : Operation_Type; ]
             Argument  : out Argument_Type
          )  is abstract;

This procedure is called when an operand is expected. That is either when no expression was recognized at all or when an infix operation or comma is not followed by an operand. The handler can return the default operand into the parameter Argument. This could be a special kind of Argument_Type reserved for such cases. The expression parsing will be then continued. In some languages, like C++ it is legal to omit operands in some cases. For example by calling parameterless functions. Alternatively On_Missing_Operand may raise an exception which would then abort parsing and propagate out of Parse. The parameter Operation is optional. It is passed when there is an operation expecting the argument on the stack top. The implementation may inspect the operation and decide which argument may fit it.

procedure On_Missing_Operation
          (  Context  : in out Lexer;
             Code     : in out Source_Type;
             Modifier : Operation_Type;
             Token    : out Lexical_Token;
             Got_It   : out Boolean
          )  is abstract;

This procedure is called when an operation expected after a premodifier was not found there. The parameter Modifier identifies it. The handler may ignore the modifier and continue parsing the expression as if there where no modifier by setting Got_It to false. It may simulate an operation by setting it to true and placing the operation token into Token. Alternatively it may raise an exception which would then abort parsing propagating out of Parse.

procedure On_Missing_Right_Bracket
          (  Context : in out Lexer;
             Code    : in out Source_Type;
             Left    : in out Operation_Type;
             Right   : out Operation_Type
          )  is abstract;

This procedure is called when the lexer detects an unclosed left bracket by finishing expression parsing. The handler can modify the left bracket specified by the parameter Left and should specify a suggested right one in the parameter Right. Alternatively it may raise an exception which would then abort parsing and propagate out of Parse.

procedure On_Wrong_Comma
          (  Context : in out Lexer;
             Code    : in out Source_Type;
             Left    : in out Operation_Type;
             Comma   : in out Operation_Type
          )  is abstract;

This procedure is called when the lexer finds incompatible comma, ligature or semicolon. It can modify the left bracket (the parameter Left), the delimiter (the parameter Comma) or both to make them compatible. Upon return Comma will be pushed onto the operation stack again with all checks suppressed. Alternatively it may raise an exception which would then abort and propagate out of Parse.

procedure On_Wrong_Right_Bracket
          (  Context : in out Lexer;
             Code    : in out Source_Type;
             Left    : in out Operation_Type;
             Right   : in out Operation_Type;
             Got_It  : out Boolean
          )  is abstract;

This procedure is called when the lexer finds incompatible brackets. There are three possibilities the implementation may choose from:

Primitive operations having an implementation:

function Is_Expected
         (  Context  : Lexer;
            Operator : Operation_Type
         )  return Boolean;

The default implementation returns true. It can be overridden to make certain operators disallowed outside brackets, e.g. ones having special meaning inside brackets like ligatures, when for certain reason it is impossible to declare the operator a ligature. For such operators this function may return false. This will cause a call to On_Unexpected, which then will decide what to do about it. Note that operators with higher association priorities can be safely disallowed only if all operators with the right association priority lower than the left association priority of Operator are disallowed as well, or else association with them is illegal. This is because a lower priority operator may hide the higher priority one from being detected, e.g. as + would do * in A+B*C. Thus either + should be disallowed too, or else the +-* association should be.

procedure On_Postmodifier
          (  Context   : in out Lexer;
             Code      : in out Source_Type;
             Operation : in out Operation_Type;
             Modifier  : Operation_Type;
             Got_It    : out Boolean
          );
procedure On_Postmodifier
          (  Context   : in out Lexer;
             Code      : in out Source_Type;
             Argument  : in out Argument_Type;
             Modifier  : Operation_Type;
             Got_It    : out Boolean
          );

These procedures are called to process postmodifiers. The parameter Modifier is the operation associated with the modifier. A postmodifier can be applied to either an operation or an argument it follows. The parameter Operation / Argument refers to the thing to modify. The procedure may observe it and change it. The parameter Got_It is set to true to indicate that the modifier was successfully processed. It is set to false to finish parsing in which case it recommended to call Reset_Pointer (Code) to bring source back to the position before the modifier. For an operation modifier this will cause a call to the On_Missing_Operand handler if that is not a postfix operation. On_Postmodifier may raise an exception which would then abort parsing. The default implementation returns the modifier back and sets Got_It to false.

procedure On_Premodifier
          (  Context   : in out Lexer;
             Code      : in out Source_Type;
             Token     : in out Lexical_Token;
             Modifier  : Operation_Type;
             Got_It    : out Boolean
          );

This procedure is called to process a premodifier. The parameter Modifier is the operation associated with the modifier. A premodifier is applied to the operation it precedes. The operation is specified by the parameter Token. The handler sets Got_It to true to indicate that Token was modified as necessary. When Got_It is set to false then the operation is discarded and parsing proceeds either to the next context allowing the modifier to be applied to an operation of another class or by discarding the modifier. That means:

On_Premodifier may raise an exception which would then abort parsing. The default implementation returns the modifier back and sets Got_It to false.

procedure On_Unexpected
          (  Context : in out Lexer;
             Code    : in out Source_Type;
             Right   : Operation_Type
          );

This procedure is called when the lexer meets an unexpected operation, comma, right bracket, ligature or semicolon specified by the parameter Right. The default implementation returns the unexpected delimiter back and then tries to complete the expression evaluation, so that the lexer will stop at the delimiter and return the expression result. This behaviour is useful when expressions bounded by commas or brackets are parsed in case of nested expressions or descending code parsers. An operation is unexpected when Is_Expected returns false. An override may raise an exception which would then abort parsing and propagate out of Parse.

procedure Pop
          (  Context : in out Lexer;
             List    : in out Frame
          );

This procedure can be used to directly manipulate the arguments stack. It fills List with arguments taken from the stack top. Constraint_Error is propagated when there is not enough arguments on the stack.

procedure Push
          (  Context  : in out Lexer;
             Argument : Argument_Type
          );

This procedure can be used to directly manipulate the arguments stack. It pushes Argument onto the arguments stack.

Informational operations:

function Get_Operation_Stack_Depth (Context : Lexer) return Natural;

This function returns the number of items on the operations stack. Note that the context may keep several parsing sessions separated by stubs. The result of this operation is the total depth of the stack, which includes all sessions and stubs between then.

function Get_Operation_Stack_Item
         (  Context : Lexer;
            Depth   : Natural := 0
         )  return Descriptor;

This function returns an operation descriptor at the stack depth specified by the parameter Depth. The topmost item has depth 0. Constraint_Error is propagated when there no requested operation on the stack. Note that the context may keep several parsing sessions separated by stubs.

13.6.1. Blank skipping

There are three child packages of Parsers.Generic_Lexer providing lexers with Get_Blank defined to skip the following blanks and comments:

These packages are generic:

generic
   type Lexer_Type (<>) is
      abstract new Parsers.Generic_Lexer.Lexer with private;
package Parsers.Generic_Lexer... is ...

The generic parameter Lexer_Type is a descendant of the type Lexer defined in the parent package (an instance of Parsers.Generic_Lexer). They derive from this type a new type and override Get_Blank as described above:

type Lexer is abstract new Lexer_Type with ...

[Back][TOC][Next]

13.7. Operations

Operations are operators, brackets, commas and ligatures. Each operation denotes some action to be executed. The parser uses several data structures based operations. These are defined using the generic package Parsers.Generic_Operation as the base package:

generic
   type Operation_Type is private;
   type Priority_Type is private;
   with function "and" (Left, Right : Operation_Type)
      return Boolean is <>;
   with function Is_Commutative (Left, Right : Operation_Type)
      return Boolean is <>;
   with function Is_Inverse (Operation : Operation_Type)
      return Boolean is <>;
   with function Group_Inverse (Operation : Operation_Type)
      return Operation_Type is <>;
   with function "<" (Left, Right : Priority_Type)
      return Boolean is <>;
package Parsers.Generic_Operation is ...

The formal generic parameters define the set of operations and their priorities:

type Operation_Type is private;

Objects of Operation_Type identify an appearance of an operation in the source. Usually it is the operation identifier with the source location attached to it. If no error diagnostic required Operation_Type can directly represent operations. The following operations should be defined on Operation_Type:

function "and" (Left, Right : Operation_Type) return Boolean;

This function is used to check operation compatibility. The parameters is one in which the corresponding operations appear in the source. The result is true if Left and be associated with Right. It is safe to return true if all operators are compatible and there is only one pair of brackets. See association checks for further information.

function Is_Commutative (Left, Right : Operation_Type)
   return Boolean;

This function returns true if Left and Right are either the same commutative operation or either the group or inverse operation of the same group. See commutative operators for further information. It is safe to define this function as false for any pair of operations if no commutative operator optimization required.

function Is_Inverse (Binary_Operator : Operation_Type)
   return Boolean;

For binary operators on which Is_Commutative is true, this function returns true if Binary_Operator is an inverse operation of the corresponding commutative group. For example, for addition it should be false, for subtraction it should be true.

function Group_Inverse (Binary_Operator : Operation_Type)
   return Operation_Type;

For the binary operators on which Is_Commutative is true this function returns the unary inverse operation of the corresponding commutative group. For example for either addition or subtraction it should return unary minus.

type Priority_Type is private;

This is the operation priority type. Higher priority operations have higher association with the operands. Priorities are ordered using "<":

function "<" (Left, Right : Priority_Type) return Boolean;

The package Parsers.Generic_Operation also defines the type Descriptor used for operation stack items:

type Descriptor_Class is (Stub, Operator, Default, Sublist, Tuple, Ligature);
type Descriptor (Class : Descriptor_Class := Stub) is record
   case
Class is
      when
Operator..Ligature =>
         Operation : Operation_Type;
         case Class is
            when
Operator..Tuple =>
               Count : Natural;
               case Class is
                  when
Operator..Sublist =>
                     Right : Priority_Type;
                  when others =>
                     null;
               end case;
            when others =>
               null;
         end case;
      when others =>
         null;
   end case;
end record;

13.7.1. Operation stack

Operation stack is one of the basic data structures used while parsing. It is used to store operations as they are recognized and rearrange them according to the precedence rules. When an operator is recognized in the source, it is pushed onto the stack. Before that all operators with right priorities higher or equal to the left priority of the new operator are popped. They get their arguments from another stack and push the result there. Left brackets are treated as stack stubs. They are popped when a right bracket appears. This simple algorithm allows to parse infix expressions without resorting to grammars.

The operation stack is provided by the generic child package Parsers.Generic_Operation.Generic_Stack:

generic
   type
Descriptor_Stack is limited private;

   type Index_Type is (<>);
   with function Get
                 (  Container : Descriptor_Stack;
                    Index     : Index_Type
                 )  return Descriptor is <>;
   with function Is_Empty (Container : Descriptor_Stack)
      return Boolean is <>;
   with function Mark (Container : Descriptor_Stack)
      return Index_Type is <>;
   with procedure Pop
                  (  Container : in out Descriptor_Stack;   
                     Count     : Natural := 1
                  )  is <>;
   with procedure Push
                  (  Container : in out Descriptor_Stack;
                     Item      : Descriptor
                  )  is <>;
   with procedure Put
                  (  Container : in out Descriptor_Stack;
                     Index     : Index_Type;
                     Element   : Descriptor
                  )  is <>;
   with function Top (Container : Descriptor_Stack)
      return Descriptor is <>;

package Parsers.Generic_Operation.Generic_Stack is ...

The generic parameters of the package define interface of a raw stack of Descriptor items. The type Descriptor is defined in the parent package. The stack interface is same as one of Generic_Stack. In the code snippet above it is highlighted. To instantiate of Parsers.Generic_Operation.Generic_Stack one could first instantiate Generic_Stack (or else Generic_Segmented_Stack) using Descriptor for the stack item (Object_Type), then use the instance package, and finally instantiate Parsers.Generic_Operation.Generic_Stack in this context with Descriptor_Stack parameter set to the raw stack type. The result package provides higher level operation stack interface:

type Stack is abstract
   new Ada.Finalization.Limited_Controlled with private;

The operation stack type is an abstract controlled type. The following primitive operations has to be implemented by derived types:

procedure Call
          (  Container : in out Stack;
             Operation : Operation_Type;
             Count     : Natural
          )  is abstract;

This procedure is called to execute an operator when all its arguments become known. Ligatures are also executed by making a call to this procedure. The parameter Operation identifies the operator being called. Count is the number of the arguments. It is not specified where arguments are located. However, it is assumed that they are accessed in LIFO order. Binary commutative operations for which Is_Commutative returns true are optimized, so that one Call is used instead of a sequence of calls in cases like A+B+C. Which will result in "+"(A,B,C) instead of "+"("+"(A,B),C).

procedure Enclose
          (  Container : in out Stack;
             Left      : Operation_Type;
             Right     : Operation_Type;
             Count     : Natural
          )  is abstract;

This procedure is called to execute brackets and sublists. Brackets could be order, aggregate, array index or function calls. In the latter two cases the first argument is the array to be indexed or the function to be called. The parameter Left identifies the left bracket or sublist separator. The parameter Right does the right one. Count is the number of the arguments. Note one extra argument for array indices and function calls.

The following operations are defined on operation stacks:

function Get (Container : Stack; Depth : Natural) return Descriptor;

This function can be used to inspect the stack contents. It returns the stack item corresponding to the parameter Depth. The topmost item is accessed using Depth=0. Constraint_Error is propagated when there no such item on the stack.

function Get_Depth (Container : Stack) return Natural;

This function returns the number of items on the stack.

function Is_Expected
         (  Container : Stack;
            Operator  : Operation_Type
         )  return Boolean;

This function is called to confirm that the Operator is allowed outside brackets. The default implementation returns true. When false is returned Unexpected_Operation will propagate. Note that this check not necessarily disallows the operator outside of brackets if there exists another operator of some lower association priority which is allowed. For example, if * is disallowed, while + is allowed, then A+B*C would be legal. Thus to disallow an operator outside the brackets its left association priority should be greater than the right priority of any allowed operator. The program can still be made illegal making association check failed from such pairs of operators, e.g. by having the association +B* illegal.

function Is_Empty (Container : Stack) return Boolean;

This function returns true if the raw stack is empty.

procedure Push_Abort (Container : in out Stack'Class);

This procedure cleans the stack to remove the side-effects of a call to Push_Start. It is used upon an unrecoverable expression evaluation errors.

procedure Push_End (Container : in out Stack'Class);

This procedure is called when the right margin of the expression reached. This can be a source end or a reserved keyword. It also can be an extra delimiter (see Unexpected_Comma, Unexpected_Right_Bracket exceptions). After successful completion the stack is returned to its state before the call to Push_Start. Missing_Right_Bracket is propagated when some left brackets of the expression remain open. A handler should either close them using Push_Right_Bracket and then try Push_End again or call Push_Abort.

procedure Push_Start (Container : in out Stack'Class);

This procedure pushes a stub onto the stack. A stub is removed by either a successful call to Push_End or by a call to Push_Abort. Parsing an expression starts with a call to Push_Start and ends by either Push_End (normal completion) or Push_Abort (abnormal completion). The operation stack is safe for recursive calls, so the same stack can be used for parsing nested expressions.

procedure Push_Binary
          (  Container : in out Stack'Class;
             Operation : Operation_Type;
             Left      : Priority_Type;
             Right     : Priority_Type;
             Unchecked : Boolean := False;
             Explicit  : Boolean := True
          );

This procedure is called when a binary infix operator is recognized in the source. The parameter Operation identifies the operator. Left and Right are the operator's priorities. Association_Error is propagated on an incompatible operator on the left. See association checks for further information. No checks made if the parameter Unchecked is set to true. The parameter Explicit should be false if the operator was assumed in place of a missing one.

procedure Push_Comma
          (  Container : in out Stack'Class;
             Operation : Operation_Type;
             Comma     : Boolean;
             Unchecked : Boolean := False
          );

This procedure is called when either a comma or a ligature is recognized in the source. When a plain comma matches the left bracket, it increases the number of arguments the list in the brackets has. A ligature does not increase the number of arguments, but binds two arguments it separates. Ligatures can be viewed as binary non-commutative operations which may appear only within brackets and have no priority. Call is applied to to execute a ligature. The parameter Comma is true when Operation identifies a comma, and false if it does a ligature. Unexpected_Comma is propagated if there is no any left bracket to match. Wrong_Comma_Type is propagated when the left bracket does not match. See association checks for further information. No checks made if the parameter Unchecked is set to true.

procedure Push_Left_Bracket
          (  Container : in out Stack'Class;
             Operation : Operation_Type
          );

This procedure is called when a left order bracket or a left bracket of an aggregate is detected. Operation identifies the bracket. Do not confuse them with the left brackets of array indices and function calls.

procedure Push_Left_Bracket
          (  Container : in out Stack'Class;
             Operation : Operation_Type;
             Left      : Priority_Type;
             Unchecked : Boolean := False
          );

This procedure is called when a left bracket of an array index or a function call is recognized in the source. Operation identifies the bracket. Left is the left priority of the bracket. Association_Error is propagated upon an incompatible operator on the left. See association checks for further information. No checks made if the parameter Unchecked is set to true.

procedure Push_Right_Bracket
          (  Container : in out Stack'Class;
             Operation : Operation_Type;
             Unchecked : Boolean := False
          );

This procedure is called to process a right bracket of any kind. The parameter Operation specifies the bracket. Unexpected_Right_Bracket is propagated when there is no any left bracket to match. Wrong_Right_Bracket_Type is propagated when the left bracket does not match.

procedure Push_Postfix
          (  Container : in out Stack'Class;
             Operation : Operation_Type;
             Left      : Priority_Type;
             Right     : Priority_Type;
             Unchecked : Boolean := False
          );

This procedure is called when a postfix unary operator is detected. The parameter Operation identifies the operator. Left and Right are the operator's priorities. Association_Error is propagated on an incompatible operator on the left. No checks made if the parameter Unchecked is set to true.

procedure Push_Prefix
          (  Container : in out Stack'Class;
             Operation : Operation_Type;
             Left      : Priority_Type;
             Right     : Priority_Type;
             Unchecked : Boolean := False
          );

This procedure is called when a prefix unary operator is detected. The parameter Operation identifies the operator. Left and Right are the operator's priorities. Association_Error is propagated on an incompatible operator on the left. No checks made if the parameter Unchecked is set to true.

procedure Push_Semicolon
          (  Container : in out Stack'Class;
             Operation : Operation_Type;
             Class     : Semicolon_Class;
             Priority  : Priority_Type;
             Unchecked : Boolean := False
          );

This procedure is used to process a sublist separator (semicolon). The paramter Operation identifies the semicolon and is used in Call when the operands: items of a sublist become all known. The parameter Class specifies the semicolon type. Priority is the association priority. Unexpected_Comma is propagated if there is no any left bracket to match. Association_Error is propagated on an operation association error, Wrong_Comma_Type does on bracket error. See association checks for further information. No checks made if the parameter Unchecked is set to true.

procedure Replace
          (  Container   : in out Stack'Class;
             Replacement : Descriptor
          );

This procedure can be used to replace an item (operation descriptor) on the stack top. Immediately after a call to Push_Start, the stack is semantically empty and contains a stub, which should never be replaced by any descriptor of other type. Constraint_Error is propagated when Container is physically empty.

function Top (Container : Stack) return Descriptor;

This function returns the stack top. Constraint_Error is propagated when the raw stack is empty.

13.7.2. Segmented operation stack

The child generic package Parsers.Generic_Operation.Segmented_Stack instantiates Parsers.Generic_Operation.Generic_Stack using the segmented stacks from the package Generic_Segmented_Stack. The package has the following generic parameters:

generic
   Segment_Size : Positive := 128;
   Minimal_Size : Positive := 64;
   Increment    : Natural  := 50;
package Parsers.Generic_Operation.Segmented_Stack is ...

These parameters controls stack allocation (see). The package instantiates Parsers.Generic_Operation.Generic_Stack under the name Operation:

package Operation is new Generic_Stack (...);

So the stack type can be denoted as instance-name.Operation.Stack, where instance-name is the name of under which Parsers.Generic_Operation.Segmented_Stack is instantiated.

13.7.3. Example of direct usage of the operation stack

The following example illustrates direct usage of the operation stack without source parsing. That is when an external lexer is used for lexical analysis. In this case the operation stack can be used as part of syntax analysis dealing with operation association. The example starts from defining the operations, their priorities and finally instantiates Parsers.Generic_Operation.Segmented_Stack providing operation stacks.

File operation_stack_expressions.ads:
with Generic_Segmented_Stack;
with Parsers.Generic_Operation.Segmented_Stack;

package Operation_Stack_Expressions is
   --
   -- Integer_Stack -- Stacks of integers to keep arguments
   --
   package Integer_Stack is
      new Generic_Segmented_Stack
          (  Index_Type   => Integer,
             Object_Type  => Integer,
             Null_Element => 0
          );
   --
   -- Operations -- The set of operations
   --
  
type Operations is (Add, Mul, Inc, Left_Bracket, Right_Bracket);
   function "and" (Left, Right : Operations) return Boolean;
   function Is_Commutative (Left, Right : Operations) return Boolean;
   function Is_Inverse (Operation : Operations) return Boolean;
   function Group_Inverse (Operation : Operations) return Operations;
   --
   -- Priorities -- The operation priorities
   --
  
type Priorities is range 1..10;
   --
   -- Raw_Descriptors -- The raw operation stack descriptors
   --
   package Raw_Descriptors is
      new Parsers.Generic_Operation (Operations, Priorities);
   --
   -- Descriptor_Stacks -- Operation stack based on raw descriptors
   --
   package Descriptor_Stacks is new Raw_Descriptors.Segmented_Stack;
   --
   -- Use the package of operation stacks deployed there
   --
   use Descriptor_Stacks.Operation;
   --
   -- Expression_Stack -- Derived from abstract operation stack to
   -- provide implementation of operation calls.
   --
   type Expression_Stack is new Stack with record
      Data : Integer_Stack.Segmented_Stack.Stack;
   end record;
   --
   -- Call -- Overrides to implement operators
   --
   procedure Call
             (  Stack     : in out Expression_Stack;
                Operation : Operations;
                Count     : Natural
             );
   --
   -- Enclose -- Overrides to implement brackets
   --
   procedure Enclose
             (  Stack : in out Expression_Stack;
                Left  : Operations;
                Right : Operations;
                Count : Natural
             );
end Operation_Stack_Expressions;

Here Integer_Stack is an instance of Generic_Segmented_Stack to keep arguments (integers). The type Operations is the set of defined operations: addition, multiplication, post-increment, left and right order brackets. The function "and" is provided for association checks. Is_Commutative and Is_Inverse always return false. Group_Inverse may return anything, it will never be called. The type Priorities defines the operation priorities. Raw_Descriptors is an instance of Parsers.Generic_Operation based on Operation and Priority. At this point Parsers.Generic_Operation.Segmented_Stack can be instantiated. Desciptor_Stacks is the instance which provides the abstract operation stack. Expression_Stack is derived from it. It has one additional data member of Integer_Stack type, that will keep the arguments of the operations. The abstract procedures Call and Enclose are overridden to implement the operations semantic.

File operation_stack_expressions.adb:
with Ada.Text_IO;  use Ada.Text_IO;

package body Operation_Stack_Expressions is
   use Integer_Stack.Segmented_Stack;

   function "and" (Left, Right : Operations) return Boolean is
   begin
      return True;
   end "and";

   function Is_Commutative (Left, Right : Operations)
      return Boolean is
   begin
      return
False;
   end Is_Commutative;

   function Is_Inverse (Operation : Operations) return Boolean is
   begin
      return
False;
   end Is_Inverse;

   function Group_Inverse (Operation : Operations)
      return Operations is
   begin
      raise
Program_Error;
      return Inc;
   end Group_Inverse;

   procedure Call
             (  Stack     : in out Expression_Stack;
                Operation : Operations;
                Count     : Natural
             )  is
      L, R : Integer;
   begin
      if
Count > 0 then
         R := Top (Stack.Data);
         Pop (Stack.Data);
      end if;
      if Count > 1 then
         L := Top (Stack.Data);
         Pop (Stack.Data);
      end if;
      case Operation is
         when
Add =>
            Push (Stack.Data, L + R);
         when Mul =>
            Push (Stack.Data, L * R);
         when Inc =>
            Push (Stack.Data, R + 1);
         when others =>
            raise Constraint_Error;
      end case;
   end Call;

   procedure Enclose
             (  Stack : in out Expression_Stack;
                Left  : Operations;
                Right : Operations;
                Count : Natural
             )  is
   begin
      null;
   end Enclose;

end Operation_Stack_Expressions;

Implementation of Call is straightforward it gets arguments from the stack evaluates the operation and pushes the result back. Enclose need nothing to do because order brackets is do not change the argument. Now the operation stack is ready to use:

File test_operation_expressions.adb:
with Operation_Stack_Expressions;
use  Operation_Stack_Expressions;

procedure Test_Operation_Stack is
   use
Operation_Stack_Expressions.Raw_Descriptors;
   use Operation_Stack_Expressions.Descriptor_Stacks.Operation;
   use Operation_Stack_Expressions.Integer_Stack.Segmented_Stack;

   Expression : Expression_Stack;
begin
   -- 1 + (2 + 3 + 4 * 5)++ + 6 * 7 + 8++
   Push_Start (Expression);
   Push (Expression.Data, 1);                      -- 1
   Push_Binary (Expression, Add, 5, 6);            -- +
   Push_Left_Bracket (Expression, Left_Bracket);   -- (
   Push (Expression.Data, 2);                      -- 2
   Push_Binary (Expression, Add, 5, 6);            -- +
   Push (Expression.Data, 3);                      -- 3
   Push_Binary (Expression, Add, 5, 6);            -- +
   Push (Expression.Data, 4);                      -- 4
   Push_Binary (Expression, Mul, 7, 8);            -- *
   Push (Expression.Data, 5);                      -- 5
   Push_Right_Bracket (Expression, Right_Bracket); -- )
   Push_Postfix (Expression, Inc, 9, 10);          -- ++
   Push_Binary (Expression, Add, 5, 6);            -- +
   Push (Expression.Data, 6);                      -- 6
   Push_Binary (Expression, Mul, 7, 8);            -- *
   Push (Expression.Data, 7);                      -- 7
   Push_Binary (Expression, Add, 5, 6);            -- +
   Push (Expression.Data, 8);                      -- 8
   Push_Postfix (Expression, Inc, 910);          -- ++
   Push_End (Expression);
   if Top (Expression.Data) /= 78 then
      raise Constraint_Error;
   end if;
end Test_Operation_Stack;

This procedure evaluates 1 + (2 + 3 + 4 * 5)++ + 6 * 7 + 8++ just by pushing arguments and the operations onto the corresponding stacks. Push_End finishes the expression evaluation and the stack of arguments contains the only one item, the expression result.

[Back][TOC][Next]

13.8. Arguments

The argument stack is the basic data structure used for parsing. It contains the expression arguments, that is the operands of operations and their results. When expression is interpreted to immediately obtain its result, arguments are usually just values. When expression is compiled into some intermediate representation, arguments are leaves and nodes of the parsing tree.

13.8.1. Argument stack

The generic package Parsers.Generic_Argument defines the base abstract type for argument stacks:

generic
   type Argument_Type is private;
package Parsers.Generic_Argument is ...

The generic parameter Argument_Type identifies appearance of an argument in the source. Usually it is the argument and a source location link. The package defines:

type Argument_No is new Positive;
type Frame is array (Argument_No range <>) of Argument_Type;

The type Frame is used to pass argument lists to the expression operations.

type Stack is abstract
   new
Ada.Finalization.Limited_Controlled with private;

The abstract base type of argument stacks. An implementation should provide the following abstract subprograms:

function Is_Empty (Container : Stack) return Boolean;

This function returns true if the current stack fragment is empty.

procedure Mark (Container : in out Stack) is abstract;

This procedure creates a new stack fragment. A stack fragment represents an independent argument stack. No arguments below mark can be accessed in any way until Release is called.

procedure Pop
          (  Container : in out Stack;
             List      : in out Frame
          )  is abstract;

This procedure pops an argument frame from the stack. The arguments fill the list provided by the parameter List. The number of arguments is defined by List'Length. Constraint_Error is propagated when Container does not contain enough arguments in the current fragment (above the last mark).

procedure Push
          (  Container : in out Stack;
             Argument  : Argument_Type
          )  is abstract;

This procedure pushes one argument onto the stack.

procedure Release (Container : in out Stack) is abstract;

This procedure should be called for each call to Mark to remove the stack fragment created by the mark. If there are any arguments on the stack pushed after the mark, they are removed. Constraint_Error is propagated when the stack does not contain any mark.

13.8.2. Segmented argument stack

The generic child package Parsers.Generic_Argument.Segmented_Stack provides an implementation of argument stack using segmented stacks from the package Generic_Segmented_Stack. The package has the following generic parameters:

generic
   Frame_Segment_Size : Positive := 128;
   Frame_Minimal_Size : Positive := 64;
   Frame_Increment    : Natural  := 50;
   Stub_Minimal_Size  : Positive := 64;
   Stub_Increment     : Natural  := 50;
package Parsers.Generic_Argument.Segmented_Stack is ...

The parameters Frame_Segment_Size, Frame_Minimal_Size and Frame_Increment controls allocation of stack segments. The parameters Stub_Minimal_Size and Stub_Increment controls a Generic_Unbounded_Array used to keep stack stubs (fragments bounds). The type Stack defined in the package:

type Stack is new Parsers.Generic_Argument.Stack with private;

[Back][TOC][Next]

13.9. Parsing tree example. Ada 95 expression parser

The package Parsers.Ada provides a full Ada 95 expression analyzer. The analyzer has the type Ada_Expression defined in the package. The analyzer recognizes an Ada expression in the source and stops at its end. The type Operations defines the Ada operations:

Name
(Operation)

Ada 95
notation

Comment. References to the corresponding sections of Ada 95 Reference Manual are given in round brackets where appropriate
Logical_And and Logical operators and short-circuit control forms (4.5.1). Logical and/or are implemented as premodifiers turning into infix operators when no short-circuit suffix defined as a postmodifier follows. As the operators all of them are declared commutative in the sense that the adjacent operators of same type will be merged into one as in the case of
A and then B and then C
Parsed to And_Then (A, B, C). All these operators have the priority level 2 (both the left and the right ones).
Logical_Or or
Logical_Xor xor
And_Then and then
Or_Else or else
EQ = Relational operators and membership tests (4.5.2). The operator not in is implemented as a premodifier not applied to the following operator in. Both membership tests are defined as an infix operators. All these operators have the priority level 3.
NE /=
LT <
LE <=
GE >
GT >=
Member in
Not_Member not in
Add + Binary adding operators (4.5.3). The operators + and - are declared commutative with the group inverse Add_Inv. The infix adding operators have the priority level 4.
Sub -
Concatenate &
Plus + Unary adding operators (4.5.4). Association checks prevent multiple unary operations association with themselves, adding, multiplying and highest precedence operators. The priority level is 5.
Minus -
Mul * Multiplying operators (4.5.5). The operators * and / are declared commutative with the group inverse Mul_Inv.  The priority level is 6.
Div /
Modulus mod
Remainder rem
Pow ** Highest precedence operators (4.5.6). These cannot be associated with themselves. They have the priority 7.
Abs_Value abs
Logical_Not not
Allocator new Allocator (4.8). An allocator is treated as a prefix operator with priority 8.
Attribute ' Attribute is treated as an infix operator with the priority 9.
Alternative | Separates choices in aggregates, treated as an infix operator. The operator is defined commutative to keep lists of alternatives whole. The operator has the priority 0.
Ellipsis .. Used in slices (4.1.2), treated as an infix operator with the priority 1.
Component . Component selector (4.1.3), treated as an infix operator. The operator is defined commutative to merge nested component selectors in one list.
Left_Bracket ( Order and aggregate brackets (4.3)
Left_Index ( Indexed components (4.1.1) and function calls (6.4). It has the left priority 9, lower than one of component selector and same as one of attributes.
Right_Bracket ) Right bracket
Comma , In brackets of all sorts
Associate => Named association, treated as a ligature
Extend with Extension aggregate separator, treated as a semicolon introducing a sublist

The identifiers are not checked against the reserved keywords. That can be done on later stages when necessary. Similarly the attributes names can be any expressions. The association checks can be relaxed by overriding corresponding error handlers. One might also wish to override the handlers to provide a more advanced error messaging mechanism than exception information.

The package defines the type Node a tagged abstract base type of all parsing tree nodes:

type Node is abstract tagged limited null record;
function Image (Item : Node) return String is abstract;
type Node_Ptr is access Node'Class;
for Node_Ptr'Storage_Pool use Tree_Pool;

The nodes of the tree are allocated on a stack. The stack is provided by a stack pool. This allows to remove the whole tree by deallocating its first allocated node or any other pool object allocated before it. Tree_Pool is the stack storage pool used for this. Nodes have the primitive operation Image used for dumping a parsing tree. The following concrete types are derived from Node:

Parsing tree nodes Comment
Character_Literal Character expression term
Expression A non-terminal node. The dicriminant Count identifies the number of successors. The field Operation is the operation associated with the node. The field Operands is the list of successors.
Identifier Identifier expression term
Integer_Literal Universal_Integer expression term
Mark Used as a stub for the stack pool to mark its state for future stack release
Missing_Operand An expression term used where no operand was found
Real_Literal Universal_Real expression term
String_Literal String expression term

All expression nodes have the field Location specifying its source location.

[Back][TOC][Next]

13.10. JSON

The packages rooted in Parsers.JSON provide an implementation of RFC 7159 JavaScript Object Notation (JSON). JSON is a primitive data representation format actively used in connection with HTTP protocol and REST API. The package Parsers.JSON provides data types of JSON objects:

type JSON_Value_Type is
     (  JSON_Boolean,
        JSON_Null,
        JSON_Number,
        JSON_String,
        JSON_Array,
        JSON_Object
     );

This type enumerates the JSON data types:

type JSON_Value
     (  JSON_Type : JSON_Value_Type := JSON_Boolean
     )  is
record
   case
JSON_Type is
      when
JSON_Boolean =>
         Condition : Boolean := False;
      when JSON_Null =>
         null;
      when JSON_Number =>
         Value : Long_Float := 0.0;
      when JSON_String =>
         Text : JSON_String_Ptr;
      when JSON_Array =>
         Sequence : JSON_Sequence_Ptr;
      when JSON_Object =>
         Map : JSON_Pair_Array_Ptr;
   end case;
end record;
type JSON_Value_Ptr is access constant JSON_Value;

This type describes a JSON value. Composite

type JSON_String_Ptr is access constant String;
type JSON_Sequence is array (Positive range <>) of JSON_Value;
type JSON_Sequence_Ptr is access constant JSON_Sequence;
type JSON_Pair is record
   Name  : JSON_String_Ptr;
   Value : JSON_Value;
end record;
type JSON_Pair_Array is array (Positive range <>) of JSON_Pair;
type JSON_Pair_Array_Ptr is access constant JSON_Pair_Array;

The following subprograms are defined for converting JSON values:

function Image
         (  Value  : JSON_Pair_Array / JSON_Sequence / JSON_Value;
            Escape
 : Boolean := False
         )  return String;

These functions return Value in JSON format. Escape if true forces all characters that are not printable or non-ASCII to be escaped.

Exceptions
Data_Error Invalid UTF-8 encoding of a tag or string value

function Image
         (  Value  : String;
            Escape
 : Boolean := False
         )  return String;

This encodes UTF-8 string Value in JSON format. Escape if true forces all characters that are not printable or non-ASCII to be escaped. The result does not contain enclosing quotation marks.

Exceptions
Layout_Error Pointer is not in Source'First..Source'Last + 1 or there is no room for output

procedure Put
          (  Destination : in out String;
             Pointer     : in out Integer;
             Value       : JSON_Pair_Array / JSON_Sequence / JSON_Value;
             Escape
      : Boolean   := False;
             Field       : Natural   := 0;
             Justify     : Alignment := Left;
             Fill        : Character := ' '
          );

These procedures place Value into the output string Destination in JSON format. The result is written starting from the Destination (Pointer). The exception Layout_Error is propagated if the value of Pointer is not in Destination'Range or there is no room for the output. Escape if true forces all characters that are not printable or non-ASCII to be escaped.

Exceptions
Data_Error Invalid UTF-8 encoding of a tag or string value
Layout_Error Pointer is not in Source'First..Source'Last + 1 or there is no room for output

procedure Put
          (  Destination : in out String;
             Pointer     : in out Integer;
             Value       : String;
             Escape
      : Boolean   := False;
             Field       : Natural   := 0;
             Justify     : Alignment := Left;
             Fill        : Character := ' '
          );

This procedure places Value into the output string Destination in JSON format without enclosing quotation marks. The string is written starting from the Destination (Pointer). The exception Layout_Error is propagated if the value of Pointer is not in Destination'Range or there is no room for the output. Escape if true forces all characters that are not printable or non-ASCII to be escaped.

Exceptions
Data_Error Invalid UTF-8 encoding of a tag or string value
Layout_Error Pointer is not in Source'First..Source'Last + 1 or there is no room for output

13.10.1. JSON parser

The generic package Parsers.JSON.Generic_Parser provides a JSON parser:

generic
   with package
Sources is new Parsers.Generic_Source (<>);
package Parsers.JSON.Generic_Parser is ...

The generic parameter Source is an instance of the generic source to parse. There are instances of the package

The package provides the function:

function Parse
         (  Code  : access Source_Type;
            Arena : access Root_Storage_Pool'Class
         )  return JSON_Value;

The function parses the source Code for an JSON object. The parts of the object are allocated in the arena storage pool specified by the parameter Arena. The pool can be erased as soon the returned result is no more used. For example Pool_Object from the package Stack_Storage.Mark_And_Release or Arena_Pool from GNAT.Sockets.Connection_State_Machine. Parsing stops at the object end.

Exceptions
Storage_Error No room in Arena to allocate parts of the object
Syntax_Error Invalid UTF-8 encoding of a tag or string value

The following code sample illustrates reading JSON object from a file:

   Arena : aliased Stack_Storage.Pool (200, 512); -- Pool to keep JSON object data
   File  : aliased File_Type;
begin
   Open (File, In_File, "test.json"); -- Open file
   declare
      Input : aliased Parsers.Multiline_Source.Text_IO.Source (File'Access);
      Data  : constant JSON_Value :=  -- Parse the file
                       Parse (Input'Access, Arena'Access);
   begin
      Put_Line ("Parsed:" & Image (Data, True)); -- Output the result
   end;
   Stack_Storage.Deallocate_All (Arena); -- Erase arena
   Close (File);

Note that the source object Input that reads the file must be created after the file is opened. The reason is that the object caches the first line from the file. If the file is not open the source will be empty.


[Back][TOC][Next]

14. Cryptography

[Back][TOC][Next]

14.1. Sequences of non-repeating pseudo-random numbers

The package Generic_Random_Sequence provides means for generation of pseudo-random sequences of non-repeating numbers. The package is generic:

generic
   type
Item_Type is mod <>;
package Generic_Random_Sequence is ...

The generic parameter Item_Type is a modular subtype which base type is used for the sequence items. The package declares it as:

subtype Element is Item_Type'Base;

The sequence items ignore any constrains the subtype Item_Type might have.

type Sequence is limited private;

This is the type of a sequence of non-repeating items of Element.

Note that the implementation requires O(m) memory where m is the modulus of Element. For this reason it is not recommended to instantiate this package with large modular types.

The following subprograms are provided:

function Length (Sequencer : Sequence) return Element;

This function returns the number of elements already generated by Sequencer. The sequence wraps at Element'Last. That is when Element'Modulus items were generated. This function can be used in order to check whether a call to Next would yield an unique item. When the result is 0, Next will start to return repeating items.

function Next (Sequencer : Sequence; Dice : Element)
   return Element;

This function returns the next sequence item. The parameter Dice is an input used in order to randomize the sequence. When Dice is 0 then consequent calls to Next will return the sequence of 0,1,2,3,... of Element. Typically Dice is an output of some pseudo-random generator of Element (or Item_Type'Base). In this case the sequence becomes pseudo-random as well. One can also use the parameter Dice for block cipher operation modes such as chaining and feedback. The first Element'Modulus items returned by the function are non-repeating. After that the next Element'Modulus items do not repeat more than once. I.e. in each cycle of Element'Modulus items no item repeats. The order in which items repeat depends on Dice. Note that even if Dice has a cycle of Element'Modulus outputs, that does not necessary imply sequence repetition.

procedure Next
          (  Sequencer : in out Sequence;
             Dice      : Element;
             Item      : out Element
          );

This is a variant of the function above shaped as a procedure.

procedure Next_Unbiased
          (  Sequencer : in out Sequence;
             Dice      : Element;
             Item      : out Element;
             Success   : out Boolean
          );

The function and procedure Next described above generate sequences biased towards zero. This procedure generates an unbiased sequence. The additional output parameter Success when false indicates that the attempt to get the next unbiased element was unsuccessful and a next attempt must be made by calling it again with another value of Dice.

procedure Start (Sequencer : in out Sequence);

This procedure starts a new sequence. It resets Sequencer to its initial state, so that the first consequent call to Next will yield exactly the same item as it did first time, provided that the Dice parameter is same, and that a call to Length will yield 0.

[Back][TOC][Next]

14.2. Symmetric serialization

The package Strings_Edit.Symmetric_Serialization provides a simple symmetric encryption and encoding for serializing plain strings. The main objective is saving and transporting user credentials in a mangled format. Note that this should be used only when deploying stronger asymmetric methods were impossible. For example when it is necessary to store user password as a string with an ability to restore it back. The encoding uses a 64-bit alphabet of digits, letters and characters '_' and '~'. Typically the key used for encryption is derived from the application name, registered user name etc. The package defines the following subtype:

subtype Encoded_String is String (1..implementation-defined);

Objects of this subtype are encoded encrypted strings. The length is fixed because the source string is always padded to 256 characters.

function Decode (Data : Encoded_String; Key : String)
   return String;

This function decodes and decrypts a string. The parameter Data is the input. The parameter Key is the key used while encryption. The exception Data_Error is propagated when Data contains invalid characters.

function Encode (Text : String; Key : String)
   return Encoded_String;

This function encrypts and encodes Text. The parameter Key is the key used for encryption. The exception Constraint_Error is propagated when Text is longer than 256 characters.

[Back][TOC][Next]

14.3. ChaCha20 chipher

The package Strings_Edit.ChaCha20 provides an implementation of the stream cipher developed by D. J. Bernstein as described in the RFC 8439.


[Back][TOC][Next]

15. Numerics

[Back][TOC][Next]

15.1. IEEE 754 representations

IEEE 754 is a widely used standard for floating-point numbers computation  The floating-point numeric types defined by the Ada language are not necessarily IEEE 754. The choice depends on the target platform's hardware. Nevertheless an Ada program may need IEEE 754 numbers when it deals with the I/O devices, network protocols, and software libraries using IEEE 754.

The library provides support for conversions between any Ada floating-point type and IEEE 754 representations. It is designed to work with the machine representations different from IEEE 754, including those with non-binary machine radix. Note that it is not intended for computations in IEEE 754 representations. When numeric computations are required a corresponding native Ada floating-point type should be used.

The package IEEE_754 is the parent of several children packages provided for handling IEEE 754 floating-point numbers. The package declares:

subtype Byte is Interfaces.Unsigned_8;

The type Byte represents one byte of an IEEE 754 floating-number data layout. The package also declares the following exceptions:

Not_A_Number_Error      : exception;
Positive_Overflow_Error : exception;
Negative_Overflow_Error : exception;

The package provides tools to deal with densely packed decimal representations:

type Decimal_Encoding is (Binary_Integer, Densely_Packed);

The encoding values are

Operations and types to pack and unpack decimals:

subtype Unpacked_Decimal is Integer range 0..999;
type
Packed_Decimal is mod 2**10;

The DPD format packs 3 decimal digits into 10-bits sequence.

function Pack (Value : Unpacked_Decimal) return Packed_Decimal;

This function packs Value in DPD.

function Unpack (Value : Packed_Decimal) return Unpacked_Decimal;

This function unpacks Value from DPD. Note that several 10-bit sequences may have same correspond same decimal value. Therefore x = Pack (Unpack (x)) is not necessarily true.

Furthermore, the package provides 128-bit integer type, since most platforms do not support it directly:

type Integer_128 is array (1..4) of Unsigned_32;
Integer_128_Zero  : constant Integer_128;
Integer_128_First : constant Integer_128;
Integer_128_Last  : constant Integer_128;

The type is encoded as 32-bit big-endian in 2's complement. The values range is -2127..2127-1. The type provides the standard set of integer operations:

function "<"  (Left, Right : Integer_128) return Boolean;
function "<=" (Left, Right : Integer_128) return Boolean;
function ">"  (Left, Right : Integer_128) return Boolean;
function ">=" (Left, Right : Integer_128) return Boolean;

function "abs" (Left : Integer_128) return Integer_128;
function "+"   (Left : Integer_128) return Integer_128;
function "-"   (Left : Integer_128) return Integer_128;

function "+" (Left, Right : Integer_128) return Integer_128;
function "-" (Left, Right : Integer_128) return Integer_128;

function "*"   (Left, Right : Integer_128) return Integer_128;
function "/"   (Left, Right : Integer_128) return Integer_128;
function "mod" (Left, Right : Integer_128) return Integer_128;
function "rem" (Left, Right : Integer_128) return Integer_128;

function "**" (Left : Integer_128; Right : Natural)
   return Integer_128;

Conversions to and from 64-bit integers:

function From_Integer_64  (Value : Integer_64 ) return Integer_128;
function From_Unsigned_64 (Value : Unsigned_64) return Integer_128;

function To_Integer_64  (Value : Integer_128) return Integer_64;
function To_Unsigned_64 (Value : Integer_128) return Unsigned_64;

15.1.1. Single precision 32-bit floating-point numbers

The generic child package IEEE_754.Generic_Single_Precision provides single precision 32-bit floating point numbers. The package is generic:

generic
   type
Number is digits <>;
package
IEEE_754.Generic_Single_Precision is ...

The formal parameter Number is the Ada floating-point type to use with the package. The type of the IEEE 754 numbers is:

type Float_32 is array (1..4) of Byte;

The values of the type are 32-bit single-precision IEEE 754 floating-point numbers .The memory layout of encoding is big-endian, i.e. the byte containing the number's sign and the most significant bits of the exponent is the first array element. The byte containing the least significant bits of the mantissa is the last array element. The following operations are defined in the package:

function From_IEEE (Value : Float_32) return Number;

This function converts Value to the corresponding Ada floating-point type. Negative zero is converted to zero. An exception is propagated when Value is not a number or else cannot be converted to Number.

Exceptions
Negative_Overflow_Error Value is less than Number'First or else is a negative infinity
Not_A_Number_Error Value is not a number (NaN)
Positive_Overflow_Error Value is greater than Number'Last or else is a positive infinity

function Is_NaN (Value : Float_32) return Boolean;

This function returns true if Value is an IEEE 754 NaN (not a number).

function Is_Negative (Value : Float_32) return Boolean;

This function returns true if Value is an IEEE 754 negative, Note that IEEE 754 has negative zeros.

function Is_Real (Value : Float_32) return Boolean;

This function returns true if Value represents a real number. Both IEEE 754 zeros are considered numbers.

function To_IEEE (Value : Number) return Float_32;

This function converts Ada floating-point number to the corresponding IEEE 754 number. The result can be an infinity if the value cannot be represented otherwise.

Positive_Infinity : constant Float_32;
Positive_Zero     : constant Float_32;
Negative_Infinity : constant Float_32;
Negative_Zero     : constant Float_32;

These constants define some special IEEE 754 representations.

The package IEEE_754.Floats is an instantiation of IEEE_754.Generic_Single_Precision with the standard type Float.

15.1.2. Double precision 64-bit floating-point numbers

The generic child package IEEE_754.Generic_Double_Precision provides single precision 64-bit floating point numbers. The package is generic:

generic
   type
Number is digits <>;
package
IEEE_754.Generic_Double_Precision is ...

The formal parameter Number is the Ada floating-point type to use with the package. The type of the IEEE 754 numbers is:

type Float_64 is array (1..8) of Byte;

The memory layout of Float_64 is big-endian. The rest of the package is identical to IEEE_754.Generic_Single_Precision with Float_64 used instead of Float_32.

The package IEEE_754.Long_Floats is an instantiation of IEEE_754.Generic_Double_Precision with the standard type Long_Float.

15.1.3. Decimal32 numbers

The package IEEE_754.Decimal32 provides and implementation of Decimal32 format. The encoding stores up to 7 decimal digits and decimal exponent into 32-bits:

type Decimal_32 is array (1..4) of Byte;
type Decimal_32_Mantissa is range -9_999_999..9_999_999;
type Decimal_32_Exponent is range -101..90;

The memory layout of encoding is big-endian, i.e. the byte containing the number's sign and the most significant bits of the exponent is the first array element. The byte containing the least significant bits of the mantissa is the last array element. The following operations are defined in the package:

function From_IEEE
         (  Value    : Decimal_32;
            Mantissa : out Decimal_32_Mantissa;
            Exponent : out Decimal_32_Exponent;
            Encoding : Decimal_Encoding := Binary_Integer
         );

This function converts Value to the corresponding mantissa and exponent. An exception is propagated when Value is not a number or else cannot be converted. Note that decimal representations are not normalized therefore same numbers can be represented by different combinations of mantissa and exponent and thus have different representations.

Exceptions
Negative_Overflow_Error Value is a negative infinity
Not_A_Number_Error Value is not a number (NaN)
Positive_Overflow_Error Value is a positive infinity

function Is_NaN (Value : Decimal_32) return Boolean;

This function returns true if Value is an IEEE 754 NaN (not a number).

function Is_Negative (Value : Decimal_32) return Boolean;

This function returns true if Value is an IEEE 754 negative, Note that IEEE 754 has negative zeros.

function Is_Real (Value : Decimal_32) return Boolean;

This function returns true if Value represents a real number.

function To_IEEE
         (  Mantissa : Decimal_32_Mantissa;
            Exponent : Decimal_32_Exponent;
            Encoding : Decimal_Encoding := Binary_Integer
        
)  return Decimal_32;

This function encodes Mantissa and Exponent into IEEE 754 Decimal32 format. Constraint_Error is propagated when the result cannot encode all digits of Mantissa.

15.1.4. Decimal64 numbers

The package IEEE_754.Decimal64 provides and implementation of Decimal64 format. The encoding stores up to 16 decimal digits and decimal exponent into 64-bits:

type Decimal_64 is array (1..8) of Byte;
type Decimal_64_Mantissa is range -9_999_999_999_999_999..9_999_999_999_999_999;
type Decimal_64_Exponent is range -398..369;

The memory layout of encoding is big-endian, i.e. the byte containing the number's sign and the most significant bits of the exponent is the first array element. The byte containing the least significant bits of the mantissa is the last array element. The following operations are defined in the package:

function From_IEEE
         (  Value    : Decimal_64;
            Mantissa : out Decimal_64_Mantissa;
            Exponent : out Decimal_64_Exponent;
            Encoding : Decimal_Encoding := Binary_Integer
         );

This function converts Value to the corresponding mantissa and exponent. An exception is propagated when Value is not a number or else cannot be converted. Note that decimal representations are not normalized therefore same numbers can be represented by different combinations of mantissa and exponent and thus have different representations.

Exceptions
Negative_Overflow_Error Value is a negative infinity
Not_A_Number_Error Value is not a number (NaN)
Positive_Overflow_Error Value is a positive infinity

function Is_NaN (Value : Decimal_64) return Boolean;

This function returns true if Value is an IEEE 754 NaN (not a number).

function Is_Negative (Value : Decimal_64) return Boolean;

This function returns true if Value is an IEEE 754 negative, Note that IEEE 754 has negative zeros.

function Is_Real (Value : Decimal_64) return Boolean;

This function returns true if Value represents a real number.

function To_IEEE
         (  Mantissa : Decimal_64_Mantissa;
            Exponent : Decimal_64_Exponent;
            Encoding : Decimal_Encoding := Binary_Integer
        
)  return Decimal_64;

This function encodes Mantissa and Exponent into IEEE 754 Decimal64 format. Constraint_Error is propagated when the result cannot encode all digits of Mantissa.

15.1.5. Decimal128 numbers

The package IEEE_754.Decimal128 provides and implementation of Decimal128 format. The encoding stores up to 34 decimal digits and decimal exponent into 128-bits:

type Decimal_128 is array (1..16) of Byte;
type Decimal_128_Exponent is range -6176..6111;

The memory layout of encoding is big-endian, i.e. the byte containing the number's sign and the most significant bits of the exponent is the first array element. The byte containing the least significant bits of the mantissa is the last array element. The following operations are defined in the package:

function From_IEEE
         (  Value    : Decimal_128;
            Mantissa : out Integer_128;
            Exponent : out Decimal_128_Exponent;
            Encoding : Decimal_Encoding := Binary_Integer
         );

This function converts Value to the corresponding mantissa and exponent. An exception is propagated when Value is not a number or else cannot be converted. Note that decimal representations are not normalized therefore same numbers can be represented by different combinations of mantissa and exponent and thus have different representations.

Exceptions
Negative_Overflow_Error Value is a negative infinity
Not_A_Number_Error Value is not a number (NaN)
Positive_Overflow_Error Value is a positive infinity

function Is_NaN (Value : Decimal_128) return Boolean;

This function returns true if Value is an IEEE 754 NaN (not a number).

function Is_Negative (Value : Decimal_128) return Boolean;

This function returns true if Value is an IEEE 754 negative, Note that IEEE 754 has negative zeros.

function Is_Real (Value : Decimal_128) return Boolean;

This function returns true if Value represents a real number.

function To_IEEE
         (  Mantissa : Integer_128;
            Exponent : Decimal_128_Exponent;
            Encoding : Decimal_Encoding := Binary_Integer
        
)  return Decimal_128;

This function encodes Mantissa and Exponent into IEEE 754 Decimal128 format. Constraint_Error is propagated when the result cannot encode all digits of Mantissa.

15.1.6. 128-bit integers editing

The package IEEE_754.Edit provides string editing facilities for 128-bit integers:

procedure Get
          (  Source  : in String;
             Pointer : in out Integer;
             Value   : out Integer_128;
             Base    : NumberBase  := 10
          );

This procedure gets an integer number from the string Source. The process starts from Source (Pointer). The parameter Base indicates the base of the expected number. The exception Constraint_Error is propagated if the number is not in the range First..Last. Data_Error indicates a syntax error in the number. End_Error is raised when no number was detected. Layout_Error is propagated when Pointer is not in the range Source'First .. Source'Last + 1.

function Value
         (  Source : String;
            Base   : NumberBase  := 10;
         )  return Integer_128;

This function gets an integer number from the string Source. The number can be surrounded by spaces and tabs. The whole string Source should be matched. Otherwise the exception Data_Error is propagated. Also Data_Error indicates a syntax error in the number. The exception Constraint_Error is propagated if the number is not in the range First..Last. End_Error is raised when no number was detected.

procedure Put
          (  Destination : in out String;
             Pointer     : in out Integer;
             Value       : Integer_128;
             Base        : NumberBase := 10;
             Put_Plus    : Boolean    := False;
             Field       : Natural    := 0;
             Justify     : Alignment  := Left;
             Fill        : Character  := ' '
          );

This procedure places the number specified by the parameter Value into the output string Destination. The string is written starting from Destination (Pointer). The parameter Base indicates the number base used for the output. The base itself does not appear in the output. The parameter Put_Plus indicates whether the plus sign should be placed if the number is positive. The exception Layout_Error is propagated when Pointer is not in Destination'Range or there is no room for the output.

function Image
         (  Value    : Integer_128;
            Base     : NumberBase := 10;
            Put_Plus : Boolean    := False
         )  return String;

This function converts Value to string. The parameter Base indicates the number base used for the output. The base itself does not appear in the output. The parameter Put_Plus indicates whether the plus sign should be placed if the number is positive.

[Back][TOC][Next]

15.2. Chebyshev series

The generic package Generic_Chebyshev_Polynomials provides functions to summation Chebyshev series:

generic
   type
Number is digits <>;
package
Generic_Chebyshev_Polynomials is ...

The package provides the following functions:

function Sum_T         (X : Number'Base; A : Coefficients) return Number'Base;
function
Sum_Even_T    (X : Number'Base; A : Coefficients) return Number'Base;
function
Sum_Odd_T     (X : Number'Base; A : Coefficients) return Number'Base;
function
Sum_Shifted_T (X : Number'Base; A : Coefficients) return Number'Base;

The parameter X is the argument of the series. The parameter A is the list of coefficients. Its type is declared in the package:

type Coefficients is array (Natural range <>) of Number'Base;

These functions sum first kind Chebyshev series:

Function Result Definition
Sum_T
N  
Σ anTn(x)
n=0  
T0(x)  =  1

T1(x)
 
 =  x
Tn+1(x)  =  2xTn(x)-Tn-1(x)
Sum_Even_T
N  
Σ anT2n(x)
n=0  
Sum_Odd_T
N  
Σ anT2n+1(x)
n=0  
Sum_Shifted_T
N  
Σ anT*n(x)
n=0  
T*n(x) = Tn(2x-1)

The package Long_Float_Chebyshev_Polynomials is an instantiation of Generic_Chebyshev_Polynomials with the standard type Long_Float.

[Back][TOC][Next]

15.3. Gamma function

The function Gamma is an approximation of Γ(x):

function Gamma (X : Float) return Float;

The implementation has relative accuracy under 5·10-8. It uses Chebyshev series approximation coefficients from Mathematical functions and their approximations by Yudell L. Luke, 1975.

[Back][TOC][Next]

15.4. Normal cubic spline interpolation

A cubic spline is a piecewise polynomial function. On each interval it is represented by a 3rd order polynom Si(x):

Si(x) = ai + bi(x-xi) + ci(x-xi)2 + di(x-xi)3

Cubic spline can be used to interpolate a function defined by a set of n pairs (xi,yi). The conditions are that the spline takes the value yi in the interpolation point xi, i.e. that:

i 1≤in-1  Si(xi) = y and  Si(xi+1) = yi+1

That its 1st and 2nd differentials are equal in the inner points, i.e. that:

i 1≤i<n-2   S'i(xi) = S'i+1(xi)   S''i(xi) = S''i+1(xi)

Additionally the normal spline is such that the second differential is 0 in the end points: S''1(x1) = S''n-1(xn) = 0. Such interpolations have the advantage of being numerically stable and efficient to compute.

The generic package Generic_Cubic_Spline provides an implementation of normal cubic splines.

generic
   type
Number is digits <>;
package Generic_Cubic_Spline is

The package provides the type

type Cubic_Spline is new Abstract_Pairs_Container with private;

The objects of the type are splines. The parent type is abstract container of pairs (xi,yi) corresponding to the interpolation points. The following operations are provided for the type:

function Acceleration
         (  Spline   : Cubic_Spline;
            Argument : Number
         )  return Number;

This function returns the value of the 2nd Spline's differential in Argument. Outside the interval [x1, xn] the result is 0. It is also 0 when the spline is defined by less than 3 interpolation points. Constraint_Error is propagated when the spline is undefined (no points set) or upon numeric errors.

function Get
         (  Spline : Cubic_Spline;
            Index  : Positive
         )  return Pair;

This function returns a pair corresponding to the interpolation point specified by Index. Constraint_Error is propagated when Index is wrong. The function is the implementation of the abstract operation of the base type.

function Get_Size (Spline : Cubic_Spline) return Natural;

This function returns the number of interpolation points. The function is the implementation of the abstract operation of the base type.

function Value
         (  Spline   : Cubic_Spline;
            Argument : Number
         )  return Number;

This function returns the value of Spline in Argument. Outside the interval [x1, xn] the result is extrapolated using the linear functions y1+S'1(x1)(x-x1) and yn+S'n-1(xn)(x-xn) correspondingly. When the spline is defined by only one point, the result is constant value in that point. When the spline is defined by two points, linear interpolation is used. Constraint_Error is propagated when the spline is undefined (no points set) or upon numeric errors.

function Velocity
         (  Spline   : Cubic_Spline;
            Argument : Number
         )  return Number;

This function returns the value of the 1st Spline's differential in Argument. Outside the interval [x1, xn] the result is constant S'1(x1) or S'n-1(xn) correspondingly. Constraint_Error is propagated when the spline is undefined (no points set) or upon numeric errors.

procedure Set (Spline : in out Cubic_Spline; Pairs : Pairs_Array);

This procedure is used to define Spline. The parameter Pairs is the array of pairs (xi,yi) to interpolate. The type of the parameter is declared in the package as:

type Pair is record
   X : Number;
   Y : Number;
end record;
type Pairs_Array is array (Positive range <>) of Pair;

The array need not to be sorted. If the values xi in the array repeat, they shall have equal corresponding values yi. Otherwise Constraint_Error is propagated. It is also propagate on numeric errors. Upon an exception propagation the argument Spline remains unmodified.

procedure Set_From_Container
          (  Spline : in out Cubic_Spline;
             Pairs  : Abstract_Pairs_Container'Class
          );

This procedure is similar to Set. It uses an abstract container of pairs (xi,yi) to interpolate as the parameter. The type of the parameter is declared in the package as:

type Abstract_Pairs_Container is
   abstract new
Ada.Finalization.Limited_Controlled with null record;

The type is abstract with the following primitive operation to override:

function Get
         (  Container : Abstract_Pairs_Container;
            Index     : Positive
         )  return Pair is abstract;

This function is used to query the pairs enumerated by the index 1... Constraint_Error is propagated when Index is wrong.

function Get_Size (Container : Abstract_Pairs_Container)
   return Natural is abstract;

This function is used to get the number of pairs in the container.

If the values xi returned by this function repeat, they shall have the corresponding values yi equal. Otherwise Constraint_Error is propagated. It is also propagated on numeric errors. Upon an exception propagation the argument Spline remains unmodified.

The package Long_Float_Cubic_Spline is an instantiation of Generic_Cubic_Spline with the type Long_Float.


[Back][TOC][Next]

16. Miscellany

[Back][TOC][Next]

16.1. Address order

The generic package Generic_Address_Order provides implementation of comparison operations performed by comparing addresses:

generic
   type
Item_Type (<>) is limited private;
package Generic_Address_Order is ...

The package provides operations:

function Equal (Left, Right : access Item_Type) return Boolean;
function Less  (Left, Right : access Item_Type) return Boolean;

[Back][TOC][Next]

16.2. SQLite bindings

The package SQLite provides bindings to SQLite. The bindings are native and intended for static linking with the data base engine, which is distributed in sources. The corresponding C files are typically incorporated into the project. The subdirectory sqlite-sources contains the official distribution of SQLite called "amalgamation." When compiled manually the object file sqlite3.o should be linked with the project.

The bindings provide the following types:

type Data_Base is tagged private;

This type is a handle to a data base connection. The connection is held until at least one handle to it exists. Handles can be copied.

function Filename
         (  Base : Data_Base;
            Name : String := "main"
         )  return String;

This function returns the name of the file associated with the data base. It is always an absolute name path. Constraint_Error is propagated when Base is not yet open.

function Open
         (  File_Name : String;
            Flags     : Open_Flags := READWRITE or CREATE or FULLMUTEX
         )  return Data_Base;

This function returns a handle to the connection. The parameter File_Name is the data base file name. Flags is the connection flags as defined by SQLite.

Exceptions
Data_Error Data base file open error related to the contents of the file
Use_Error An open error related to the file existence and accessibility rights

procedure Close (Base : in out Data_Base);

This closes the data-base and finalizes all relevant objects.

type Statement is tagged private;

This type is a handle to a statement, an SQL command to execute. The statement is held until at least one handle to it exists. Handles can be copied. Handle to statement also holds a reference to the data base connection. A statement is need to be prepared, then its non literal parameters are bound, then the statement is executed step by step per each row of the result. After that the statement can be reset, parameters rebound and the statement executed again. The following code snippet illustrates use of statements:

declare
   Command : Statement := Prepare (DB, "some SQL command");
begin
   Bind (Command, ...); -- Binding parameters
   while Step (Command) loop   -- Getting one row of the result set
      ... Column (Command) ... -- Taking the results out
   end loop;
   Reset (Command);     -- Clean up, if we want to execute again
   Bind (Command, ...); -- Binding other parameters
   ...

The operations defined on statements are:

procedure Bind
          (  Command   : Statement;
             Parameter : Positive;
             Value     : double / int / Integer_64 / String / Stream_Element_Array
          );
procedure
Bind
          (  Command   : Statement;
             Parameter : Positive;
             Value     : access String / access Stream_Element_Array
          );
procedure
Bind
          (  Command   : Statement;
             Parameter : Positive
          );

The parameters to be bound are usually specified as ? in the command text (see Prepare). Each such parameter has to be bound to a value. The position of a parameter is specified by its index, i.e. by the position of ? in the command text. The first parameter has the position 1. The variants with Value of access String or Stream_Element_Array types are used when the caller takes the responsibility not to destroy the array all the time the binding is used. In this case an attempt is made to prevent extra copying of the array contents. Otherwise the bound value is copied by the database engine. The copy is kept until the command object exists or else the parameter is rebound. The variant without the parameter Value binds the parameter to SQL NULL. The following example illustrates use of Bind with an access parameter:

declare
   Command : Statement := Prepare (DB, "SELECT address FROM customers WHERE name = ?");
   Name    : aliased String := ...
begin
   Bind (Command, 1, Name'Access); -- Bind name (will not be copied)
   if Step (Command) then          -- Here is the address
      Put_Line (Name & " has the address " & Column (Command, 1));
   else
      Put_Line (Name & " is not registered");
   end if;
end;

Exceptions
Constraint_Error Command or Parameter is invalid or else SQLite return code SQLITE_RANGE.
Data_Error Data base error. The following SQLite return codes are mapped to this exception: SQLITE_INTERNAL, SQLITE_NOMEM, SQLITE_INTERRUPT, SQLITE_IOERR, SQLITE_CORRUPT, SQLITE_FULL, SQLITE_PROTOCOL, SQLITE_EMPTY, SQLITE_SCHEMA, SQLITE_TOOBIG, SQLITE_CONSTRAINT, SQLITE_MISMATCH, SQLITE_MISUSE, SQLITE_NOLFS, SQLITE_FORMAT, SQLITE_NOTADB, SQLITE_ROW,
SQLITE_DONE.
End_Error Not found error (usually related to a non-existent table or data base) (SQLite return codes: SQLITE_ERROR, SQLITE_NOTFOUND)
Status_Error Access error (SQLite return codes: SQLITE_ABORT, SQLITE_BUSY, SQLITE_LOCKED, SQLITE_READONLY, SQLITE_AUTH)
Use_Error File existence and accessibility rights related errors (SQLite return codes: SQLITE_PERM | SQLITE_CANTOPEN)

procedure Column
          (  Command  : Statement;
             Position : Positive
          )  return double / int / Integer_64 / String / Stream_Element_Array;

This function returns Position column of the result set of Command, when it is executed. The function Column is used after Step. The columns are counted from 1. Constraint_Error is propagated when Command is invalid. Note that SQLite checks virtually nothing. Therefore this function must be used with great care.

function Column_Count (Command : Statement) return Natural;

This function returns the number of columns of the result set of Command, when it is executed. This function is used after Step. Constraint_Error is propagated when Command is invalid.

procedure Column_Type
          (  Command  : Statement;
             Position : Positive
          )  return Datatype;

This function returns the type of column Position in the result set of Command. The columns are counted from 1. Constraint_Error is propagated when Command is invalid.

procedure Exec (Base : Data_Base; Command : String);

This function is a combination of Prepare and iterated Step. The exceptions propagated by this function are same as in Bind.

function Is_Null
         (  Command  : Statement;
            Position : Positive
         )  return Boolean;

This function returns true if the Position column of the result set of Command, when it is executed. This function is used after Step. Constraint_Error is propagated when Command is invalid.

function Is_Valid (Command : Statement) return Boolean;

This function returns true if Command refers to a valid command.

function Last_Insert_Row (Base : Data_Base'Class) return Row_ID;

This function returns the last inserted row identification. Note that SQLite does not cache anything in order to prevent race condition of this function in presence of multiple tasks.

function Prepare
         (  Base    : Data_Base'Class;
            Command : String
         )  return Statement;

This function translates an SQL query and returns a handle to the statement ready to execute using Step. The exceptions propagated by this function are same as in Bind.

procedure Reset (Command : Statement);

This procedure ends execution of a statement initiated by Step. After that the statement can be executed again. Constraint_Error is propagated when Command is invalid.

function SQL (Command : Statement) return String;

This function returns an UTF-8 string containing the SQL text of the statement without bound parameters expanded.

function SQL_Show (Command : Statement) return String;

This function returns an UTF-8 string containing the SQL text of the statement with bound parameters expanded.

procedure Step (Command : Statement);
function Step (Command : Statement) return Boolean;

These subprograms execute a statement prepared by Prepare with parameters bound by Bind. The function Step returns true if there is a row of the result set to use in Column. When the result is false, there is no row and this indicates completion of the command execution. The exceptions propagated by these subprograms are same as in Bind.

function Table_Exists (Base : Data_Base; Name : String) return Boolean;

This function returns true if there is the table Name. The exceptions propagated by this function are same as in Bind.

The performance of SQLite can be significantly improved when explicit transactions are used. If you have a sequence of statements to perform always put them in the transaction brackets like:

Exec (DB, "BEGIN");
... -- Individual requests
Exec (DB, "COMMIT");

function Version return String;

This function returns the library version, e.g. 3.25.3.

16.2.1. Backup interface

The backup interface allows copying between two databases.

type Backup is tagged private;

This type is a handle to a data base backup object. The object is used to copy data bases.

procedure Copy
          (  Base      : Data_Base;
             Name      : String := "main";
             File_Name : String
          );

This procedure copies Base to the file File_Name. The parameter Name specifies the data base, e.g. main.

Exceptions
Constraint_Error Base is invalid data base handle
Data_Error Data base error
Status_Error Access error
Use_Error File open error

function Init
         (  Destination      : Data_Base'Class;
            Destination_Name : String := "main";
            Source           : Data_Base'Class;
            Source_Name      : String := "main"
         )  return Backup;

This procedure creates a backup object. Destination and Destination_Name are the data base object and name to copy into. Source and Source_Name are the data base and name to copy from. The caller must have an exclusive access to the destination.

Exceptions
Constraint_Error Invalid data base handle
Data_Error Data base error
Status_Error Access error
Use_Error File open error

function Pagecount (Object : Backup) return int;

This function returns the total number of pages to backup.

Exceptions
Constraint_Error Invalid handle
Data_Error Data base error

function Remaining (Object : Backup) return int;

This function returns the number of pages remaining to backup.

Exceptions
Constraint_Error Invalid handle
Data_Error Data base error

procedure Step
          (  Object : Backup;
             Pages  : int := -1
          );

This procedure backups the specified number of pages or all remaining pages. When Pages is omitted all remaining pages are backed up.

Exceptions
Constraint_Error Invalid data base handle
Data_Error Data base error
Status_Error Access error
Use_Error File open error

16.2.2. Tracing interface

The following procedures control tracing facilities:

function Get_User_Data
         (  Base : Data_Base
         )  return Object.Entity_Ptr;

This function returns a pointer to the user data object set by the last call to Set_User_Data. It is null is unset. Constraint_Error is propagated when Base is not yet open.

procedure Set_Trace (Base : Data_Base; Tracer : On_Statement);
procedure Set_Trace (Base : Data_Base; Tracer : On_Profile);
procedure Set_Trace (Base : Data_Base; Tracer : On_Row);
procedure Set_Trace (Base : Data_Base; Tracer : On_Close);

The parameter Tracer specifies the callback used on the corresponding event:

type On_Statement is access procedure
     (  Command   : Statement'Class;
        Query     : String;
        User_Data : Object.Entity_Ptr
     );

The parameter Command indicates the statement. Note that the statement passed into the callback is not the original Ada object. It is a new object referencing the original prepared statement object. The SQL query is specified by the parameter Query. It is the UTF-8 encoded. The parameter User_Data is a pointer to the object set in the last call to Set_User_Data.

type On_Profile is access procedure
     (  Command   : Statement'Class;
        Elapsed   : Duration;
        User_Data : Object.Entity_Ptr
     );

The parameter Command indicates the statement. Note that the statement passed into the callback is not the original Ada object. The parameter Elapsed is the statement execution duration. The parameter User_Data is a pointer to the object set in the last call to Set_User_Data.

type On_Row is access procedure
   
 (  Command   : Statement'Class;
        User_Data : Object.Entity_Ptr
     );

The parameter Command indicates the statement. Note that the statement passed into the callback is not the original Ada object. The parameter User_Data is a pointer to the object set in the last call to Set_User_Data.

type On_Close is access procedure
 
    (  User_Data : Object.Entity_Ptr
     );

 The parameter User_Data is a pointer to the object set in the last call to Set_User_Data.

procedure Set_User_Data
          (  Base      : Data_Base;
             User_Data : Object.Entity_Ptr
          );

This procedure sets a user reference-counted object. It can be null to remove the previously set object. Once the object is set a reference is held on it which prevents its destruction until the database connection referenced by Base exists. It can be set like this

Set_User_Data (Base, new My_Data);

and the newly allocated object will be freed if no more used. Constraint_Error is propagated when Base is not yet open.

[Back][TOC][Next]

16.3. Block streams

The package Block_Streams provides a stream built upon a stream of blocks transported over another stream:

block stream

The motivation behind a block stream is when binary data are sent over or stored by an unreliable transport. For example, when using Ada.Streams.Stream_IO to read/write binary file or when sending over a socket using either TCP or UDP protocols, there is no guarantee that the file will be consistently read back or that the network peer would receive the stream data uncorrupted. The block stream adds a safety layer above an unsafe transport stream exposing itself as a stream which can be safely accessed. The data written or read from the block stream are grouped into blocks of fixed size. Each block is supplied with the sequence number and the check sum (Fletcher-16). When read the block number and the check sum are verified.

16.3.1. Input block stream

The package defines the input block stream as follows:

type Input_Block_Stream
     (  Transport : access Root_Stream_Type'Class;
        Size      : Stream_Element_Count
     )  is new Root_Stream_Type with private;

The discriminant Transport is the stream used to read blocks from. Size is the block size in Stream_Element units. Writing into an input stream propagates Use_Error exception. Failed checks cause Data_Error propagation. The following operations are defined additionally:

function Get_Block_No
         (  Stream : Input_Block_Stream
         )  return Unsigned_32;

This function returns the number of the block being read. It is the sequence number + 1. Note that block numbers wrap at 232.

function Get_Element_No
         (  Stream : Input_Block_Stream
         )  return Stream_Element_Count;

This function returns the number of the next stream element of the block to read. The first element has the number 1. The last element has the number Size - 6.

procedure Skip (Stream : in out Input_Block_Stream);

This procedure reads all blocks with the non-zero sequence numbers. It can be used to resynchronize the consumer (stream reader) with the producer (stream writer) connected peer to peer. This assumes that the producer starts each series of output data with the sequence number 0.

16.3.2. Output block stream

The package defines the input block stream as follows:

type Output_Block_Stream
     (  Transport : access Root_Stream_Type'Class;
        Size      : Stream_Element_Count
     )  is new Root_Stream_Type with private;

The discriminant Transport is the stream used to write blocks to. Size is the block size in Stream_Element units. Reading from an output stream propagates Use_Error exception. The following operations are defined additionally:

function Get_Block_No
         (  Stream : Output_Block_Stream
         )  return Unsigned_32;

This function returns the number of the block being written. It is the sequence number + 1. Note that block numbers wrap at 232.

function Get_Element_No
         (  Stream : Output_Block_Stream
         )  return Stream_Element_Count;

This function returns the number of the next stream element of the block to write. The first element has the number 1. The last element has the number Size - 6.

procedure Flush (Stream : in out Output_Block_Stream);

This procedure is called to write the last block if there is any pending output. After that writing the stream will start at the sequence number 0.

[Back][TOC][Next]

16.4. Storage streams

The package Storage_Streams provides streams allocated in the memory. The stream can be read and written.

type Storage_Stream
     (  Block_Size : Stream_Element_Count
     )  is new Root_Stream_Type with private;

The discriminant Block_Size is block size in stream elements. When the stream is written the memory is allocated by blocks of this size. The blocks read out of the stream are kept allocated and reused as necessary. Additionally to the standard operations, the following operations are provided:

procedure Erase (Stream : in out Storage_Stream);

This procedure erases all written contents of Stream.

function Get_Size (Stream : Storage_Stream) return Stream_Element_Count;

This function returns the number of stream elements available for read.

[Back][TOC][Next]

16.5. String streams

The package Strings_Edit.Streams provides streams backed by a string. A string can be set into the stream object and then its contents accessed through the stream interface. An object can also be written as a stream and then the written contents taken as a string.

[Back][TOC][Next]

16.6. Pipe streams

The package Pipe_Streams provides streams that can be used as a pipe between two tasks. The stream can be read and written. The reader is blocked when there is no data available to read. Similarly the writer is blocked when there is no space available to write. Each side of the stream can be closed to propagate End_Error on an attempt to read or write correspondingly. Also the stream can set into the sink mode to accept and ignoring all writing.

Consider the following example of using a pipe stream. Let there is a compiler that reads the source from a stream and a communication task receiving the source over some networking protocol. The communication produces chunks of the source to compile so that there is no complete source at any time. The communication writes chunks into the pipe stream. The compiler is ran by a separate task and reads from the pipe. Now consider different scenarios:

The following data types are defined in the package:

type Pipe_Stream
    (  Size : Stream_Element_Count
    )  is new Root_Stream_Type with private;

This is the type of the stream. The following operations are provided:

procedure Erase (Stream : in out Pipe_Stream);

This procedure makes the stream empty and available to read/write.

function Available_To_Read (Stream : Pipe_Stream)
   return Stream_Element_Count;

This function returns how many stream items can be read without blocking.

function Available_To_Write (Stream : Pipe_Stream)
   return Stream_Element_Count;

This function returns how many stream items can be written without blocking.

procedure Close_Read (Stream : in out Pipe_Stream);

This procedure closes the read stream end. Reading from the stream will propagate End_Error when the stream is empty instead of blocking.

procedure Close_Write (Stream : in out Pipe_Stream);

This procedure closes the write stream end. Writing into the stream will propagate End_Error.

function Is_Empty (Stream : Pipe_Stream) return Boolean;

This function returns true if there is no data ready to read from the stream. The subsequent read will block if no writing happens in between.

function Is_Full (Stream : Pipe_Stream) return Boolean;

This function returns true if there is no space to write into the stream. The subsequent write will block if no reading happens in between.

function Is_Read_Closed (Stream : Pipe_Stream) return Boolean;

This function returns true if reading from the stream is closed. Reading from the stream will propagate End_Error.

function Is_Sink (Stream : Pipe_Stream) return Boolean;

This function returns true if writing into the stream is a void operation.

function Is_Write_Closed (Stream : Pipe_Stream) return Boolean;

This function returns true if writing into the stream is closed. Writing into the stream will propagate End_Error.

procedure Sink (Stream : in out Pipe_Stream);

This procedure sets the stream in the sink mode. All newly written data are accepted and ignored.

[Back][TOC][Next]

16.7. ChaCha20 encrypted streams

The package Strings_Edit.ChaCha20 provides streams that decipher the transport stream associated with the stream upon read and encipher upon write. Since ChaCha20 is a symmetric cipher deciphering and enciphering are same.

[Back][TOC][Next]

16.8. ODBC bindings

ODBC stands for Open DataBase Connectivety, an interface to access database management systems is a more or less vendor-independent way. The DBMS such as MySQL or PostgreSQL is contacted using an ODBC driver which is responsible to abstract DBMS specific details. An ODBC driver can also be used to access spreadsheet applications, e.g. MS Excel has an ODBC driver. A database in ODBC is represented by so called data source. A data source is configured by specifying the ODBC driver responsible for the source and parameters specific to the driver. Typically it is the IP address of the server, port, user credentials etc. In other cases it could be the data base file name. Each data source has a unique name (DSN) assigned when it is configured. In order to access a data base the application must know the DSN and optionally the user name and password.

16.8.1. Thin bindings

The package ODBC.Thin provides thin bindings to ODBC, which closely follows C API. As such it should be somewhat inconvenient to use. Where possible, plain string types like char_array and wchar_array are used instead of access SQLCHAR (SQLCHAR *).

The ODBC data types and constants are defined in the package ODBC.SQLTypes.

The packages named ODBC.Driver_Dependent encapsulate driver manager specific parts of thin bindings. Presently two driver managers are supported:

When GNAT projects are used the scenario variable odbc selects the driver manager:

odbc value Description
ODBC32 Used with Microsoft ODBC driver manager
unixODBC Used with unixODBC driver manager

The packages named ODBC.Architecture_Dependent define data types depending on the machine architecture. The differences in ODBC interface for 64- and 32-bit systems are described in the document: INFO: ODBC 64-Bit API Changes in MDAC 2.7 (see).

When GNAT projects are used the scenario variable arch selects the architecture:

arch value Description
i686 32-bit architecture
x86_64 64-bit architecture

16.8.2. Thick bindings

The package ODBC.API provides higher level ODBC bindings. The ODBC handles are encapsulated into controlled types to ensure their safe allocation and deallocation:

The operations provided by the package check the ODBC return code and propagate following exceptions instead:

16.8.3. ODBC environments

The package ODBC.API declares the type ODBC_Enviroment:

type ODBC_Environment is
   new
Ada.Finalization.Limited_Controlled with private;

The environment defines general properties shared between connections to the data sources. It is usually the ODBC driver manager to stand behind an environment. Though there could be multiple instances of ODBC environment, normally there should be only one. The following primitive operations are defined on ODBC environment objects:

procedure Finalize (Environment : in out ODBC_Environment);

This procedure frees the environment handle. When a new type is derived from ODBC_Environment and this operation is overridden the new implementation must call it from its body.

function Get_<attribute-name>
         (  Environment : ODBC_Environment
         )  return <attribute-value>;
procedure Set_<attribute-name>
          (  Environment : in out ODBC_Environment;
             Value       : <attribute-value>
          );

These operations are used to get and set environment attributes, e.g. Get_Connection_Pooling, Set_Connection_Pooling. The operation name follows the attribute name. Refer to SQL_ATTR_<attribute-name> for further information. Usually the attributes must be set before first connection using the environment is created. The following table lists the functions:

Attribute name Result type Attribute description
Connection_Pooling SQL_CB The level of connection pooling support
CP_Match SQL_CP_MATCH The way a connection is chosen from a connection pool
ODBC_Version SQL_OV The ODBC version
Output_NTS Boolean True if the driver returns NUL-terminated strings

function Get_First_DSN
         (  Environment   : ODBC_Environment;
            DSN           : DSN_Type;
            Buffer_Length : Positive := Default_Block_Size
         )  return DSN_Description;

This function returns a description of the first data source of the type specified by the parameter DSN. The data type is defined as:

type DSN_Type is (Any_DSN, System_DSN, User_DSN);

The result has the type:

type DSN_Description
     (  Name_Length        : Natural;
        Description_Length : Natural
     )  is record
   Name        : String (1..Name_Length);
   Description : String (1..Description_Length);
end record;

The parameter Buffer_Length specifies the maximum length of the data source description. Constraint_Error is propagated when the actual length exceeds that limit. End_Error is propagated when there is no data sources of the requested type. The next data source of this type can be obtained using Get_Next_DSN.

function Get_Next_DSN
         (  Environment   : ODBC_Environment;
            Buffer_Length : Positive := Default_Block_Size
         )  return DSN_Description;

This function returns a description of the next data source of the type specified by the parameter DSN of the last call to Get_First_DSN. The parameter Buffer_Length specifies the maximum length of the data source description. Constraint_Error is propagated when the actual length exceeds that limit. I this case the enumeration of data sources should likely be restarted because it is not guaranteed that a consequent call with a larger value of the parameter will fetch the same data source again. End_Error is propagated when there is no data sources of the requested type.

function Get_<record-field>
         (  Environment   : ODBC_Environment;
            Record_Number : Positive := 1
         )  return <field-value>;

These operations are used to get diagnostic record fields, e.g. Get_Message_Text. The operation name record field name. Refer to SQL_DIAG_<record-field> for further information. The parameter Record_Number indicates the record for which the field is requested. The following table lists the functions:

Diagnostic field name Result type Field description
Class_Origin String A string that indicates the document that defines the class portion of the SQLSTATE value in this record
Column_Number SQLINTEGER The value that represents the column number in the result set or the parameter number in the set of parameters
Connection_Name String The name of the connection that the diagnostic record relates to
Message_Text String,
Wide_String
An informational message on the error or warning
Native SQLINTEGER A driver/data source-specific native error code. If there is no native error code, the driver returns 0
Number SQLINTEGER The number of status records available
Returncode SQLRETURN Return code returned by the function
Row_Number SQLLEN The row number in the rows set, or the parameter number in the set of parameters, with which the status record is associated
Server_Name String,
Wide_String
A string that indicates the server name that the diagnostic record relates to
SQLSTATE String A five-character SQLSTATE diagnostic code. For more information
Subclass_Origin String Identifies the defining portion of the subclass portion of the SQLSTATE code

procedure Initialize (Environment : in out ODBC_Environment);

This procedure allocates an environment handle and sets the ODBC version to the value defined by the constant Used_ODBC_Version declared in the package ODBC.API. However the version can be changed before any connection objects created using Set_ODBC_Version with an appropriate version value. When a new type is derived from ODBC_Environment and this operation is overridden the new implementation must call it from its body.

16.8.4. ODBC connections

The package ODBC.API declares the type ODBC_Connection:

type ODBC_Connection
     (  Environment : access ODBC_Environment'Class
     )  is new Ada.Finalization.Limited_Controlled with private;

A connection object represents a data source such as a data base. It refers to its environment object through the access discriminant Environment. Data sources are configured system-wide or on user basis. Refer to the ODBC documentation for the configuration issues. The following primitive operations are defined on ODBC connection objects:

procedure Connect
          (  Connection  : in out ODBC_Connection;
             Server_Name : String;
             User_Name   : String;
             Password    : String;
             Auto_Commit : Boolean
          );
procedure
Connect
          (  Connection  : in out ODBC_Connection;
             Server_Name : Wide_String;
             User_Name   : Wide_String;
             Password    : Wide_String;
             Auto_Commit : Boolean
          );

This procedure should be called once immediately after the object construction in order to establish a connection to the data base, though possibly after setting some connection attributes. The parameter Server_Name refers to a configured data source (DSN). The parameters User_Name and Password specify DBMS user credentials required to access the data source. The parameter Auto_Commit specifies automatic vs. manual commit mode of the connection.

procedure Disable_Tracing (Connection : in out ODBC_Connection);

This procedure stops tracing previously enabled by Enable_Tracing.

procedure Drop
          (  Connection : in out ODBC_Connection;
             Table_Name : String
          );
procedure
Drop
          (  Connection : in out ODBC_Connection;
             Table_Name : Wide_String
          );

These procedures delete the specified table. Nothing happens if no such table exists. Note that the names of tables can be case sensitive. Furthermore the driver may change the case upon table creation. This behavior can be queried as connection information.

procedure Enable_Tracing
          (  Connection : in out ODBC_Connection;
             File_Name  : String
          );
procedure Enable_Tracing
          (  Connection : in out ODBC_Connection;
             File_Name  : Wide_String
          );

This procedure enables tracing into the file which name is specified by the parameter File_Name. The way and format of tracing depends on the ODBC driver servicing the connection. Note that tracing can be extremely resource consuming. It should be used with great care.

procedure End_Transaction (Connection : in out ODBC_Connection);

This procedure commits transaction. See transactions for further information.

procedure Finalize (Connection : in out ODBC_Connection);

This procedure closes the connection and frees the connection handle. When a new type is derived from ODBC_Connection and this operation is overridden the new implementation must call it from its body.

function Get_<attribute-name>
         (  Connection : ODBC_Connection
         )  return <attribute-value>;
procedure Set_<attribute-name>
          (  Connection : in out ODBC_Connection;
             Value      : <attribute-value>
          );

These operations are used to get and set connection attributes, e.g. Get_Access_Mode, Set_Access_Mode. The operation name follows the attribute name. Refer to SQL_ATTR_<attribute-name> for further information. It is attribute-dependent whether it can be set before or after the connection is established. Use_Error is propagated when the attribute is not supported by the driver, however for some drivers Data_Error may be propagated instead of Use_Error. The following table lists the functions:

Attribute name Result type Attribute description
Access_Mode SQL_MODE1 The connection mode: read or read-write
Async_DBC_Enable Boolean true if asynchronous execution of selected functions enabled
Async_Enable Boolean true if a function called with a statement on the specified connection is executed asynchronously
Auto_IPD Boolean true if automatic population of the IPD after a call to Prepare is supported
Autocommit Boolean true if the driver uses auto-commit mode
Login_Timeout Duration Login timeout. The attribute has 1 second resolution
Metadata_ID Boolean true if the string argument of catalogue functions are treated as identifiers
Packet_Size Positive The network packet size in bytes
Trace Boolean true if tracing is on
Tracefile String,
Wide_String
The trace file name or empty string
Translate_Lib String,
Wide_String
The name of a library containing the functions that the driver accesses to perform tasks such as character set translation
Translate_Option SQLUINTEGER1 A 32-bit flag value that is passed to the translation library
TXN_Isolation SQL_TXN1 The bitmask that sets the transaction isolation level

function Get_<information-token-name>
         (  Connection : ODBC_Connection
         )  return <information-token-value>;

These operations are used to get information, e.g. Get_Accessible_Procedures. The operation name follows the information type of the function SQLGetInfo. Refer to SQL_<information-token-name> for further information. The following table lists the functions:

Information token name Result type Description
A
Accessible_Procedures Boolean true if all procedures returned by Get_Procedures can be executed
Accessible_Tables Boolean true if the user is guaranteed SELECT privileges to all tables returned by Get_Tables
Active_Environments Natural The maximum number of active environments that the driver can support, zero if there is no limit or the limit is unknown
Aggregate_Functions SQL_AF1 A bitmask enumerating support for aggregation functions
Alter_Domain SQL_AD1 A bitmask enumerating the clauses in the ALTER DOMAIN statement
Alter_Table SQL_AT1 A bitmask enumerating the clauses in the ALTER TABLE statement supported by the data source
Async_DBC_Functions Boolean true if the driver can execute connection functions asynchronously
Async_Mode SQL_AM1 The level of asynchronous support in the driver, e.g. at the connection level, statement level or none
B
Batch_Row_Count SQL_BRC1 A bitmask that enumerates the behaviour of the driver with respect to the availability of row counts
Batch_Support SQL_BS1 A bitmask that enumerating the driver's support for batches
Bookmark_Persistence SQL_BP1 A bitmask that enumerating the operations through which bookmarks persist
C
Catalog_Location SQL_CL1 The position of the catalogue in a qualified table name
Catalog_Name Boolean true if the server supports catalogue names
Catalog_Name_Separator String Characters that the data source defines as the separator between a catalogue name and the qualified name element that follows or precedes it
Catalog_Term String A character string with the data source vendor's name for a catalogue; for example, "database" or "directory". This string can be in upper, lower, or mixed case
Catalog_Usage SQL_CU1 A bitmask enumerating the statements in which catalogues can be used
Collation_Seq String The name of the collation sequence
Column_Alias Boolean true if the data source supports column aliases
Concat_Null_Behavior SQL_CB1 Describes handling the concatenation of NULL valued character data type columns with non-NULL valued character data type columns
Connection_Dead Boolean true if the connection was lost
Connection_Timeout Duration This function returns a value corresponding to the number of seconds to wait for any request on the connection to complete before returning to the application
Convert_Functions SQL_FN_CVT1 A bitmask enumerating the scalar conversion functions supported
Correlation_Name SQL_CN1 Indicates whether table correlation names are supported
Create_Assertion SQL_CA1 A bitmask enumerating the clauses in the CREATE ASSERTION statement
Create_Character_Set SQL_CCS1 A bitmask enumerating the clauses in the CREATE CHARACTER SET statement
Create_Collation SQL_CCOL1 A bitmask enumerating the clauses in the CREATE COLLATION statement
Create_Domain SQL_CDO1 A bitmask enumerating the clauses in the CREATE DOMAIN statement
Create_Schema SQL_CS1 A bitmask enumerating the clauses in the CREATE SCHEMA statement
Create_Table SQL_CT1 A bitmask enumerating the clauses in the CREATE TABLE statement
Create_Translation SQL_CTR1 A bitmask enumerating the clauses in the CREATE TRANSLATION statement
Create_View SQL_CV1 A bitmask enumerating the clauses in the CREATE VIEW statement
Current_Catalog String,
Wide_String
The name of the catalogue to be used by the data source
Cursor_Commit_Behavior SQL_CCB1 How a COMMIT operation affects cursors and prepared statements
Cursor_Rollback_Behavior SQL_CCB1 How a ROLLBACK operation affects cursors and prepared statements
Cursor_Sensitivity SQL_SENSITIVITY1 Value that indicates the support for cursor sensitivity
D
Data_Source_Name String,
Wide_String
The data source name that was used during connection
Data_Source_Readonly Boolean true if the data source is set to READ ONLY mode
Database_Name String,
Wide_String
The name of the current database in use
Datetime_Literals SQL_DL1 A bitmask enumerating the SQL-92 datetime literals supported
DBMS_Name String,
Wide_String
The name of the DBMS product accessed by the driver
DBMS_Version String The version of the DBMS product accessed by the driver. The result has the format ##.##.####
DDL_Index SQL_DI1 Value that indicates support for creation and dropping of indexes
Default_TXN_Isolation SQL_TXN1 The default transaction isolation level supported by the driver or data source
Describe_Parameter Boolean true if parameters can be described
DM_Version String The driver manager version in the form ##.##.####.####
Driver_Name String,
Wide_String
The file name of the driver used to access the data source
Driver_ODBC_Ver String The version of ODBC that the driver supports in the form ##.##
Driver_Ver String A character string with the version of the driver and optionally, a description of the driver
Drop_Assertion SQL_DA1 A bitmask enumerating the clauses in the DROP ASSERTION statement
Drop_Character_Set SQL_DCS1 A bitmask bitmask enumerating the clauses in the DROP CHARACTER SET statement
Drop_Collation SQL_DC1 A bitmask enumerating the clauses in the DROP COLLATION statement
Drop_Domain SQL_DD1 A bitmask enumerating the clauses in the DROP DOMAIN statement
Drop_Schema SQL_DS1 A bitmask enumerating the clauses in the DROP SCHEMA statement
Drop_Table SQL_DT1 A bitmask enumerating the clauses in the DROP SCHEMA statement
Drop_Translation SQL_DTR1 A bitmask enumerating the clauses in the DROP TRANSLATION statement
Drop_View SQL_DV1 A bitmask enumerating the clauses in the DROP VIEW statement
Dynamic_Cursor_Attributes SQL_CA1,
SQL_CA21
A bitmask that describes the attributes of a dynamic cursor
E
Expressions_In_Orderby Boolean true if the data source supports expressions in the ORDER BY list
F
File_Usage SQL_FILE1 The result specifies how a single-tier driver directly treats files in a data source
Forward_Only_Cursor_Attributes SQL_CA1,
SQL_CA21
A bitmask that describes the attributes of a forward-only cursor
G
Getdata_Extensions SQL_GD1 A bitmask enumerating extensions to Get_Data
Group_By SQL_GR1 The result describes the relationship between the columns in the GROUP BY clause and the non-aggregated columns in the select list
I
Identifier_Case SQL_IC1 Identifier case
Identifier_Quote_Char String The character string that is used as the starting and ending delimiter of a quoted (delimited) identifier in SQL statements
Index_Keywords SQL_IE1 A bitmask that enumerates keywords in the CREATE INDEX statement that are supported by the driver
Info_Schema_Views SQL_ISV1 A bitmask enumerating the views in the INFORMATION_SCHEMA that are supported by the driver
Insert_Statement SQL_IS1 A bitmask that indicates support for INSERT statements
Integrity Boolean true if the data source supports the Integrity Enhancement Facility
K
Keyset_Cursor_Attributes SQL_CA1,
SQL_CA21
A bitmask that describes the attributes of a keyset cursor
Keywords String A comma-separated list of all data source-specific keywords
L
Like_Escape_Clause Boolean true if the data source supports an escape character for the percent character (%) and underscore character (_) in a LIKE predicate and the driver supports the ODBC syntax for defining a LIKE predicate escape character
M
Max_Async_Concurrent_Statements Natural The maximum number of active concurrent statements in asynchronous mode, zero if there is no known limit
Max_Binary_Literal_Len Natural This function returns the maximum length (number of hexadecimal characters, excluding the literal prefix and suffix returned by Get_Type_Info) of a binary literal in an SQL statement. For example, the binary literal 0xFFAA has a length of 4. If there is no maximum length or the length is unknown, this value is set to zero
Max_Catalog_Name_Len Natural The maximum length of a catalogue name in the data source, zero if there is no known limit
Max_Char_Literal_Len Natural The maximum length (number of characters, excluding the literal prefix and suffix of a character literal in an SQL statement, zero if there is no known limit
Max_Column_Name_Len Natural The maximum length of a column name in the data source, zero if there is no known limit
Max_Columns_In_Group_By Natural The maximum number of columns allowed in a GROUP BY clause, zero if there is no known limit
Max_Columns_In_Index Natural The maximum number of columns allowed in an index, zero if there is no known limit
Max_Columns_In_Order_By Natural The maximum number of columns allowed in an ORDER BY clause, zero if there is no known limit
Max_Columns_In_Select Natural The maximum number of columns allowed in a select list, zero if there is no known limit
Max_Columns_In_Table Natural The maximum number of columns allowed in a table, zero if there is no known limit
Max_Concurrent_Activities Natural The maximum number of active statements that the driver can support for a connection. A statement is defined as active if it has results pending, with the term "results" meaning rows from a SELECT operation or rows affected by an INSERT, UPDATE, or DELETE operation (such as a row count), or if it is in a NEED_DATA state. This value can reflect a limitation imposed by either the driver or the data source. If there is no specified limit or the limit is unknown, this value is set to zero
Max_Cursor_Name_Len Natural The maximum length of a cursor name in the data source, zero if there is no known limit
Max_Driver_Connections Natural The maximum number of active connections supported, zero if there is no known limit
Max_Identifier_Len Natural The maximum size in characters for user-defined names, zero if there is no known limit
Max_Index_Size Natural The maximum number of bytes in the combined fields of an index, zero if there is no known limit
Max_Procedure_Name_Len Natural The maximum length of a procedure name in the data source, zero if there is no known limit
Max_Row_Size Natural The maximum length of a single row in a table, zero if there is no known limit
Max_Row_Size_Includes_Long Boolean true if the maximum row size returned for the Get_Max_Row_Size information type includes the length of all SQL_LONGVARCHAR and SQL_LONGVARBINARY columns in the row
Max_Schema_Name_Len Natural The maximum length of a schema name in the data source, zero if there is no known limit
Max_Statement_Len Natural The maximum length (number of characters, including white space) of an SQL statement, zero if there is no known limit
Max_Table_Name_Len Natural The maximum length of a table name in the data source, zero if there is no known limit
Max_Tables_In_Select Natural The maximum number of tables allowed in the FROM clause of a SELECT statement, zero if there is no known limit
Max_User_Name_Len Natural The maximum length of a user name in the data source, zero if there is no known limit
Multiple_Result_Sets Boolean true if the driver supports multiple result sets
Multiple_Active_TXN Boolean true if the driver supports more than one active transaction at the same time
N
Need_Long_Data_Len Boolean true if the data source needs the length of a long data value
Non_Nullable_Columns SQL_NNC1 A value the specifies whether the data source supports NOT NULL in columns
Null_Collation SQL_NC1 A value that specifies where NULLs are sorted in a result set
Numeric_Functions SQL_FN_NUM1 A bitmask enumerating the scalar numeric functions supported by the driver and associated data source
O
ODBC_Interface_Conformance SQL_OIC1 A value that indicates the level of the ODBC 3.x interface that the driver complies with
ODBC_Ver String A character string with the version of ODBC to which the Driver Manager conforms. The format is ##.##.0000
OJ_Capabilities SQL_OJ1 A bitmask enumerating the types of outer joins supported
Order_By_Columns_In_Select Boolean true if the columns in the ORDER BY clause must be in the select list
P
Param_Array_Row_Count SQL_PARC1 A value enumerating the driver's properties regarding the availability of row counts in a parameterized execution
Param_Array_Selects SQL_PAS1 A value enumerating the driver's properties regarding the availability of result sets in a parameterized execution
Procedure_Term String A character string with the data source vendor's name for a procedure
Procedures Boolean true if the data source supports procedures and the driver supports the ODBC procedure invocation syntax
Pos_Operations SQL_POS1 A bitmask enumerating the support operations in Set_Pos
Q
Quoted_Identifier_Case SQL_IC1 The case used for quoted identifiers
R
Row_Updates Boolean true if a keyset-driven or mixed cursor maintains row versions or values for all fetched rows
S
Schema_Term String A character string with the data source vendor's name for a schema
Schema_Usage SQL_SU1 A bitmask enumerating the statements in which schemas can be used
Scroll_Options SQL_SO1 A bitmask enumerating scroll options
Search_Pattern_Escape String A character string specifying what the driver supports as an escape character that allows the use of the pattern match metacharacters underscore (_) and percent sign (%) as valid characters in search patterns
Server_Name String A character string with the actual data source-specific server name
Special_Characters String A character string that contains all special characters
SQL_Conformance SQL_SC1 A value that indicates the level of SQL-92 supported by the driver
SQL92_Datetime_Functions SQL_SDF1 A bitmask enumerating the datetime scalar functions that are supported by the driver
SQL92_Foreign_Key_Delete_Rule SQL_SFKD1 A bitmask enumerating the rules supported for a foreign key in a DELETE statement
SQL92_Foreign_Key_Update_Rule SQL_SFKU1 A bitmask enumerating the rules supported for a foreign key in an UPDATE statement
SQL92_Grant SQL_SG1 A bitmask enumerating the clauses supported in the GRANT statement
SQL92_Numeric_Value_Functions SQL_SNVF1 A bitmask enumerating the numeric value scalar functions that are supported by the driver and the associated data source, as defined in SQL-92
SQL92_Predicates SQL_SP1 A bitmask enumerating the numeric value scalar functions that are supported by the driver and the associated data source
SQL92_Relational_Join_Operations SQL_SRJO1 A bitmask enumerating the relational join operators supported in a SELECT statement, as defined in SQL-92
SQL92_Revoke SQL_SR1 A bitmask enumerating the clauses supported in the REVOKE statement, as defined in SQL-92
SQL92_Row_Value_Constructor SQL_SRVC1 A bitmask enumerating the row value constructor expressions supported in a SELECT statement, as defined in SQL-92
SQL92_String_Functions SQL_SSF1 A bitmask enumerating the string scalar functions that are supported by the driver and the associated data source, as defined in SQL-92
SQL92_Value_Expressions SQL_SVE1 A bitmask enumerating the value expressions supported, as defined in SQL-92
Standard_CLI_Conformance SQL_SCC1 A bitmask enumerating the CLI standard or standards to which the driver conforms
Static_Cursor_Attributes SQL_CA1,
SQL_CA21
A bitmask that describes the attributes of a static cursor supported
Subqueries SQL_SQ1 A bitmask enumerating the predicates that support subqueries
String_Functions SQL_FN_STR1 A bitmask enumerating the scalar string functions supported by the driver and associated data source
System_Functions SQL_FN_SYS1 A bitmask enumerating the scalar system functions supported by the driver and associated data source
T
Table_Term String A character string with the data source vendor's name for a table
Timedate_Add_Intervals SQL_FN_TSI1 A bitmask enumerating the timestamp intervals supported by the driver and associated data source for the TIMESTAMPADD scalar function
Timedate_Diff_Intervals SQL_FN_TSI1 A bitmask enumerating the timestamp intervals supported by the driver and associated data source for the TIMESTAMPDIFF scalar function
Timedate_Functions SQL_FN_TSI1 A bitmask enumerating the scalar date and time functions supported by the driver and associated data source
TXN_Capable SQL_TC1 Describes the transaction support in the driver or data source
TXN_Isolation_Option SQL_TXN1 A bitmask enumerating the transaction isolation levels available from the driver or data source
U
Union SQL_U1 A bitmask enumerating the support for the UNION clause
User_Name String,
Wide_String
The name used in a particular database
X
XOpen_CLI_Year String,
Wide_String
A character string that indicates the year of publication of the Open Group specification with which the version of the ODBC Driver Manager fully complies
1 Defined in the package ODBC.SQLTypes

function Get_Convert
         (  Connection : ODBC_Connection;
            Data_Type  : SQL_DATA_TYPE
         )  return SQL_CVT;

The result is the bitmask indicates the conversions supported by the data source with the CONVERT scalar function for data of the type specified. If the bitmask equals zero, the data source does not support any conversions from data of the named type, including conversion to the same data type.

function Get_Execution_Mode (Connection : ODBC_Connection)
   return Execution_Mode;

This function returns current execution mode.

function Get_Functions
         (  Connection  : ODBC_Connection;
            Function_ID : SQL_API
         )  return Boolean;

This function returns true if the function specified by the parameter Function_ID is supported by the driver.

function Get_<record-field>
         (  Connection    : ODBC_Connection;
            Record_Number : Positive := 1
         )  return <field-value>;

These operations are used to get diagnostic record fields, e.g. Get_Message_Text. The operation name record field name. Refer to SQL_DIAG_<record-field> for further information. The parameter Record_Number indicates the record for which the field is requested. The following table lists the functions:

Diagnostic field name Result type Field description
Class_Origin String A string that indicates the document that defines the class portion of the SQLSTATE value in this record
Column_Number SQLINTEGER1 The value that represents the column number in the result set or the parameter number in the set of parameters
Connection_Name String The name of the connection that the diagnostic record relates to
Message_Text String,
Wide_String
An informational message on the error or warning
Native SQLINTEGER1 A driver/data source-specific native error code. If there is no native error code, the driver returns 0
Number SQLINTEGER1 The number of status records available
Returncode SQLRETURN1 Return code returned by the function
Row_Number SQLLEN1 The row number in the rows set, or the parameter number in the set of parameters, with which the status record is associated
Server_Name String,
Wide_String
A string that indicates the server name that the diagnostic record relates to
SQLSTATE String A five-character SQLSTATE diagnostic code. For more information
Subclass_Origin String Identifies the defining portion of the subclass portion of the SQLSTATE code

procedure Initialize (Connection : in out ODBC_Connection);

This procedure allocates a connection handle. When a new type is derived from ODBC_Connection and this operation is overridden the new implementation must call it from its body.

procedure Release (Connection : in out ODBC_Connection);

This procedure is opposite to Seize, it releases previously locked data base. See transactions for further information.

procedure Rollback (Connection : in out ODBC_Connection);

This procedure discards the effect of current transaction. See transactions for further information.

procedure Seize (Connection : in out ODBC_Connection);

This procedure is called to lock the data base. The access to the data base becomes serialized. This procedure may fail if the driver does not support serialized transactions (see Serializable). The database is unlocked by calling to Release. See transactions for further information.

procedure Serializable (Connection : ODBC_Connection);

When this function returns false, it is unsafe to access the data base concurrently, because the drives provides no interlocking. If the result is true, Seize can be called to start a safe transaction.

procedure Set_Execution_Mode
          (  Connection : in out ODBC_Connection;
             Mode       : Execution_Mode
          );

This procedure changes current execution mode.

function Table_Exists
         (  Connection : access ODBC_Connection;
            Table_Name : String
         )  return Boolean;
function
Table_Exists
         (  Connection : access ODBC_Connection;
            Table_Name : Wide_String
         )  return Boolean;

These functions return true if a table with the specified name exists in the data base. Note that the driver may consider table names case-sensitive in some cases and case-insensitive in others. When searching for a table using this function, the table name must be in the canonic form, otherwise the driver may fail finding it.

16.8.5. Transactions

The package ODBC.API declares the type

type Execution_Mode is (None, Read_Only, Read_Write);

The execution mode is get and set using Get_Execution_Mode and Set_Execution_Mode.

When the execution mode is set to None a call to Execute causes propagation of Use_Error. The difference between Read_Only and Read_Write modes is provided for convenience. Both Read_Only and Read_Write actually allow Execute. Note also that execution mode does not influence the connection attribute SQL_ATTR_ACCESS_MODE (see Get_Access_Mode). In fact, ODBC does not recommend changing this attribute on an established connection, anyway. Furthermore, setting this attribute does not necessarily prevent the driver from updating the data base.

The default execution mode is Read_Write. in which everything is supposed to be allowed. The execution mode None is useful in the transaction (manual-commit) mode to detect potential bugs caused by executing statements outside transactions, which is a very common source of errors.

Typically an application using transactions will set the execution mode to None between the transactions. A transaction could be performed as follows:

Read-only transaction: The application calls Seize and sets the mode to Read_Only. Upon transaction completion it calls End_Transaction, then Release, and, finally, sets the mode back to None. Instead of End_Transaction it could also call Rollback. Assuming that no changes were made to the data base during a read-only transaction anyway, both should be equivalent.

Read-write transaction: The application calls Seize and sets the mode to Read_Write. Upon transaction completion it calls either End_Transaction in order to commit the changes made or else Rollback to drop the changes. After that Release is called, and, finally, the mode is set back to None.

Note that the ODBC drivers may support no transactions. Use the function Serializable to check if the necessary transactions isolation level is provided.

16.8.6. ODBC commands

The package ODBC.API declares the type ODBC_Command:

type ODBC_Command
     (  Connection : access ODBC_Connection'Class
     )  is new Ada.Finalization.Limited_Controlled with private;

The object represents an SQL statement and the result set associated with it. The access discriminant ODBC_Connection refers to the connection object to be used by the statement. A connection may have several statements associated with it. The following primitive operations are defined on ODBC_Command:

procedure Bind_Parameter
          (  Command   : in out ODBC_Command;
             Index     : Positive;
             Parameter : access <parameter-data-type>;
             Data_Type : SQL_DATA_TYPE := <data-type-specification>
          );
procedure Bind_Null
          (  Command : in out ODBC_Command;
             Index   : Positive
          );

These procedures bind a variable to a parameter to the command specified by the parameter Command. The command must be first prepared using Prepare. The parameters to be bound are specified in the statement as ?. Each such parameter has to be bound to a variable using a call to a Bind_Parameter. The parameter Index specifies the position of the parameter, i.e. the number of ? counting from 1. The parameter Parameter specifies the object keeping the value and additional information required by the driver. The package ODBC.Bound_Parameter provides such types declared for data types like SQLINTEGER etc. The variant Bind_Null binds null value to the parameter.

procedure Bind_Result
          (  Command   : in out ODBC_Command;
             Column    : Positive;
             Parameter : access <result-data-type>
          );

These procedures bind a variable to the result set's column of the command specified by the parameter Command. The command must be first prepared using Prepare. When a row of the result set is fetched the value of the column specified by the parameter Column is stored into the variable specified by Parameter. The following data types available for this parameter:

procedure Close_Cursor (Command : in out ODBC_Command);

This procedure explicitly closes cursor. All errors on closing cursor are ignored. When Execute produces a result set, the cursor is placed to a row in this set. In order to execute command once more, the cursor must be closed. The variants of Execute the statement specified as a parameter (direct execution) automatically close current cursor. The variants of Execute using prepared statement may fail if the cursor is not closed. The operation Get_Data has cursor disposition parameter controlling when close the cursor.

function Describe_Col
         (  Command : ODBC_Command;
            Column  : Positive
         )  return Column_Description;

This function returns a description of the column specified by the parameter Column. The parameter Command specifies a prepared command of which result set column is requested. The number of columns can be obtained using Num_Result_Cols. The result of the function has the type declared as follows:

type Column_Description (Name_Length : Natural) is record
   Data_Type      : SQL_DATA_TYPE;
   Column_Size    : SQLULEN;
   Decimal_Digits : Natural;
   Nullable       : SQL_NULLABLE_FIELD;
   Column_Name    : String (1..Name_Length);
end record;

function Describe_Param
         (  Command   : ODBC_Command;
            Parameter : Positive
         )  return Param_Description;

This function returns description of a prepared statement parameter. The parameters are specified using ? mark (see Prepare). The result has the type declared as follows:

type Param_Description is record
   Data_Type      : SQL_DATA_TYPE;
   Parameter_Size : SQLULEN;
   Decimal_Digits : Natural;
   Nullable       : SQL_NULLABLE_FIELD;
end record;

Use_Error is propagated when the driver does not support parameter description. The function Num_Params returns the number of parameters of a prepared statement.

procedure Drop
          (  Command    : in out ODBC_Command;
             Table_Name : String
          );
procedure
Drop
          (  Command    : in out ODBC_Command;
             Table_Name : Wide_String
          );

These procedures delete the specified table. Nothing happens if no such table exists. The parameter Command is scratch command to use in the operation.

procedure Execute
          (  Command : in out ODBC_Command
          );
procedure Execute
          (  Command : in out ODBC_Command;
             Text    : String
          );
procedure
Execute
          (  Command : in out ODBC_Command;
             Text    : Wide_String
          );

These procedures execute a command. When the parameter Text is omitted the command to be executed is one prepared before using Prepare. Otherwise it is prepared from the statement specified by the parameter Text. The effect of execution of a command could be a result set which is navigated using the procedure Fetch. A call to Fetch gives access to a row of the result set. Columns of the row are accessed using Get_Data. For prepared statements columns can be bound to variables using Bind_Result to extract values automatically. Use_Error is propagated when current execution mode is set to None. Status_Error is propagated when a table specified in the statement does not exist. Data_Error has standard for the binding meaning: any other error reported by the driver.

function Execute
         (  Command : access ODBC_Command
         )  return Natural;
function Execute
         (  Command : access ODBC_Command;
            Text    : String
         )  return Natural;
function
Execute
         (  Command : access ODBC_Command;
            Text    : Wide_String
         )  return Natural;

These functions are provided for convenience. They first call the corresponding Execute operation and then return the result of Row_Count, indicating the number of rows affected by the statement execution. The affected rows are those inserted, modified, deleted by the statement executed.

procedure Fetch (Command : in out ODBC_Command);
function
Fetch
         (  Command : access ODBC_Command
         )  return SQLRETURN;

These operations fetch a new row from the result set obtained by a Execute. End_Error is propagated when there is no more rows in the result set. After a successful execution of Fetch, the results bound by Bind_Result are set. Other columns can be obtained using Get_Data.

procedure Finalize (Command : in out ODBC_Command);

This procedure closes the connection and frees the statement handle. When a new type is derived from ODBC_Command and this operation is overridden the new implementation must call it from its body.

function Get_Data
         (  Command : access ODBC_Command;
            Column  : Positive;
            Finish  : Cursor_Disposition
         )  return <result-data-type>;
function
Get_Data
         (  Command       : access ODBC_Command;
            Column        : Positive;
            Finish        : Cursor_Disposition;
            Null_As_Empty : Boolean  := True;
            Block_Size    : Positive := Default_Block_Size
         )  return String;
function
Get_Data
         (  Command       : access ODBC_Command;
            Column        : Positive;
            Finish        : Cursor_Disposition;
            Null_As_Empty : Boolean  := True;
            Block_Size    : Positive := Default_Block_Size
         )  return Wide_String;

The data of the specified column are read from the result of a command execution. The command is specified by the parameter Command. The row of the result set must be fetched first, using a call to Fetch. When there is no row available End_Error is propagated. It is also propagated when the requested column value is NULL, unless suppressed by the parameter Null_As_Empty. The column in the result set is specified by the parameter Column. Note that some ODBC drivers might require accessing the result columns in their number order. When the cursor associated with the result set remains unclosed the command processing should be either continued using a new Fetch or finished calling Close_Cursor explicitly. The parameter Finish determines whether Get_Data should close the cursor. The type is defined as:

type Cursor_Disposition is (Never, On_Error, On_No_Result, Always);

Typically, the data from the columns of the last row are queried with the dispositions On_No_Result, On_No_Result...On_Error, On_No_Result...Always. The following result data types are supported:

Functions returning strings have additional parameters controlling memory allocation and treatment of NULL values. Note that some data bases do not support NULL values for some data types, these could for example return an empty string, and so the result of Get_Data will be an empty string rather than End_Error. The parameter Null_As_Empty additionally explicitly suppresses propagation of End_Error when the field is NULL. The parameter Block_Size specifies the character size in which string data are fetched. When the column value exceeds this size Get_Data first extracts all parts of the value and then assembles the result. See Prepare for sample code illustrating usage of Get_Data.

procedure Get_Data
          (  Command       : in out ODBC_Command;
             Stream        : in out Root_Stream_Type'Class;
             Column        : Positive;
             Finish        : Cursor_Disposition;
             Null_As_Empty : Boolean := True;
             Block_Size    : Stream_Element_Count :=
                                Default_Block_Size
          );

This procedure is similar to the Get_Data returning a string with the difference that the pieces of string are written directly into the stream specified by the parameter Stream. The data are requested as a C char array (the target type is SQL_C_CHAR). Which is assumed equivalent to Stream_Element. The parameter Block_Size specifies the number of stream elements requested at a time. If the data length exceeds this number (excluding null terminator) the implementation extracts data in parts. For each part Write is called on Stream. Note that the bounds of the data array are not written into the stream. The following code sample illustrates usage with a string stream (see Strings_Edit.Streams):

declare
   Command : aliased ODBC_Command (Connection'Access);
   Stream  : String_Stream (100);
begin
   Prepare
   (  Command,
      String'("SELECT * FROM test_table WHERE x1=10")
   );
   Execute (Command);
   loop
      Fetch (Command);
      Get_Data (Command, Stream, 2, Never);   -- Write data into the stream
      Put_Line ("Column 2 = " & Get (Value)); -- Get stream contents
      Rewind (Stream); -- Erase data written into the stream
   end loop;
exception
   when
End_Error => -- No more rows
      null;
end;

procedure Get_Data
          (  Command       : in out ODBC_Command;
             Destination   : in out String;
             Pointer       : in out Integer;
             Column        : Positive;
             Finish        : Cursor_Disposition;
             Null_As_Empty : Boolean := True;
          );

This procedure places the string column data into the string Destination starting from the position indicated by Pointer. After successful completion Pointer is advanced to the first character following the data. Layout_Error is propagated when either Pointer is outside Destination'First..Destination'Last + 1 or else there is no room in Destination for the column data.

function Get_<attribute-name>
         (  Command : ODBC_Command
         )  return <attribute-value>;
procedure Set_<attribute-name>
          (  Command : in out ODBC_Command;
             Value   : <attribute-value>
          );

These operations are used to get and set command attributes, e.g. Get_Access_Mode, Set_Access_Mode. The operation name follows the attribute name. Refer to SQL_ATTR_<attribute-name> for further information. Use_Error is propagated when the attribute is not supported by the driver, however for some drivers Data_Error may be propagated instead of Use_Error. The following table lists the functions:

Attribute name Result type Attribute description
Async_Enable Boolean true if function called with the specified statement is executed asynchronously
Concurrency SQL_CONCUR1 A bitmask that specifies the cursor concurrency support
Cursor_Scrollable Boolean true if cursor is scrollable
Cursor_Sensitivity SQL_SENSITIVITY1 Specifies whether cursors on the statement handle make visible the changes made to a result set by another cursor
Cursor_Type SQL_CURSOR1 A value that specifies the cursor type
Enable_Auto_IPD Boolean true if automatic population of the IPD is performed
Keyset_Size SQLULEN1 The number of rows in the keyset for a keyset-driven cursor
Max_Length SQLULEN1 The maximum amount of data that the driver returns from a character or binary column
Max_Rows SQLULEN1 The maximum number of rows to return to the application for a SELECT statement. 0 indicates all rows to return
Metadata_ID Boolean true if the string argument of catalog functions are treated as identifiers
Noscan Boolean true if the driver does not scan SQL strings for escape sequences
Query_Timeout Duration Time to wait before returning to the application
Retrieve_Data Boolean true if fetching retrieves data after it positions the cursor to the specified location
Row_Array_Size SQLULEN1 The number of rows returned upon fetching
Row_Number SQLULEN1 The number of the current row in the entire result set

function Get_<record-field>
         (  Command       : ODBC_Command;
            Record_Number : Positive := 1
         )  return <field-value>;

These operations are used to get diagnostic record fields, e.g. Get_Message_Text. The operation name record field name. Refer to SQL_DIAG_<record-field> for further information. The parameter Record_Number indicates the record for which the field is requested. The following table lists the functions:

Diagnostic field name Result type Field description
Class_Origin String A string that indicates the document that defines the class portion of the SQLSTATE value in this record
Column_Number SQLINTEGER1 The value that represents the column number in the result set or the parameter number in the set of parameters
Connection_Name String The name of the connection that the diagnostic record relates to
Cursor_Row_Count SQLLEN1 This field contains the count of rows in the cursor
Dynamic_Function String,
Wide_String
Describes the SQL statement that the underlying function executed
Message_Text String,
Wide_String
An informational message on the error or warning
Native SQLINTEGER1 A driver/data source-specific native error code. If there is no native error code, the driver returns 0
Number SQLLEN1 The number of status records that are available
Returncode SQLRETURN Return code returned by the function
Row_Count SQLLEN1 The number of rows affected by an insert, delete, or update
Server_Name String,
Wide_String
A string that indicates the server name that the diagnostic record relates to
SQLSTATE String A five-character SQLSTATE diagnostic code. For more information
Subclass_Origin String Identifies the defining portion of the subclass portion of the SQLSTATE code

procedure Get_Tables
          (  Command    : in out ODBC_Command;
             Table_Type : String := "TABLE"
          );

This procedure enumerates tables. The effect is a result set containing a row per table. The result set can be navigated using usual means. The columns of the result are described in the driver manager documentation (see SQLTables). The parameter Command is the scratch command to use by the operation. The parameter Table_Type specifies the type of tables to enumerate. It is a list of comma separated values, possibly put in quotation marks each. The default value is used to enumerate only normal tables. Row_Count can be used immediately after Get_Tables in order to determine the number of rows, which is same the number of tables found.

function Get_Type_Info
         (  Command   : access ODBC_Command;
            Data_Type : SQL_DATA_TYPE
         )  return Type_Info;

This function returns a description of the type specified by the parameter Data_Type. The parameter Command specifies a scratch command to use. The result of the function has the type declared as follows:

type Type_Info
     (  Type_Name_Length         : Natural;
        Literal_Prefix_Length    : Natural;
        Literal_Suffix_Length    : Natural;
        Create_Parameters_Length : Natural;
        Local_Name_Length        : Natural
     )  is
record

   Data_Type          : SQL_DATA_TYPE;
   Column_Size        : SQLINTEGER;
   Searchable         : SQL_COLUMN_SEARCHABLE;
   Nullable           : Boolean;
   Case_Sensitive     : Boolean;
   Unsigned_Attribute : Boolean;
   Fixed_Prec_Scale   : Boolean;
   Auto_Unique_Value  : Boolean;
   Type_Name          : String (1..Type_Name_Length);
   Local_Name         : String (1..Local_Name_Length);
   Literal_Prefix     : String (1..Literal_Prefix_Length);
   Literal_Suffix     : String (1..Literal_Suffix_Length);
   Create_Parameters  : String (1..Create_Parameters_Length);
end record;

The fields of the record describe the type. Note that the type name may vary, i.e. be different from the name of the Data_Type constant. E.g. SQL_TINYINT may be named 'BYTE' etc. The choice depends on the driver. Note all data types defined by SQL_DATA_TYPE in the package ODBC.SQLTypes are actually supported by the driver. Constraint_Error is propagated when the driver does not support the data type specified.

function Num_Params (Command : ODBC_Command) return Natural;

This function returns the number of parameters of a prepared command. The parameters are specified using ? mark. These parameters are bound to values using Bind_Parameter. See also Describe_Param for parameter description.

function Num_Result_Cols (Command : ODBC_Command) return Natural;

This function returns the number of columns in the result set of a prepared command.

procedure Prepare
          (  Command : in out ODBC_Command;
             Request : String
          );
procedure Prepare
          (  Command : in out ODBC_Command;
             Request : Wide_String
          );

These procedures prepare an SQL statement which can be then executed several times. The parameter Request specifies the statement to prepare in Command. Execution of a prepared statement is more efficient than direct execution. Both are done by calling to Execute. (Execute without SQL statement parameter executes a prepared command. Execute with SQL statement parameter does direct execution) Carefully observe that prepared statements might get lost between transactions. A prepared statement may have parameters denoted using the ? mark in the statement's text. These parameters are bound to values using Bind_Parameter before calling to Execute. This allows statements to have varying parameters. Bound parameters are especially useful for passing binary data, which otherwise would require complex SQL escaping syntax if specified as literals in the statement text. The statement columns of the result set also can be bound using Bind_Result. The following sample illustrates use of a prepared statement with parameters bound:

declare
   Command  : aliased ODBC_Command (Connection'Access);
   ID       : aliased SQLINTEGER_Parameter;
   Customer : aliased String_Parameter (100);
begin

   Prepare
   (  Command,
      String'("INSERT INTO my_table VALUES (?,?)")
   );
   Bind_Parameter (Command, 1, ID'Access);
   Bind_Parameter (Command, 2, Customer'Access);
   ID.Value := 24;
   Set (Customer, String'("John");
   Execute (Command);
   ID.Value := 25;
   Set (Customer, String'("Judy");
   Execute (Command);
end
;

The next sample illustrates getting results of a prepared statement using a variable bound to the first column and an explicit call to Get_Data for the second column:

declare
   Command : aliased ODBC_Command (Connection'Access);
   ID      : aliased SQLINTEGER;
begin

   Execute (Command, String'("SELECT * FROM my_table"));
   Bind_Result (Command, 1, ID'Access);
   loop
      Fetch (Command);
      Put_Line
      (  "ID:" & SQLINTEGER'Image (ID)
      &  " Name:" & Get_Data (Command'Access, 2, On_No_Result)
      );
   end loop;
exception
   when
End_Error => -- No more rows
      null
;
end
;

An ODBC_Command object can be reused by preparing another SQL statement in it or using it with operations requiring a scratch command, e.g. Get_Tables etc.

function Row_Count
         (  Command : ODBC_Command
         )  return Natural;

This function returns the number of rows affected by the previously executed command such as INSERT, DELETE etc.

procedure Set_Pos
          (  Command   : in out ODBC_Command;
             Row       : Positive;
             Operation : SQL_OPERATION;
             Locking   : SQL_LOCKTYPE
          );

This procedure changes position in the row set. Row specifies the row, when 0 operation applies to all rows. Operation is the operation to perform. Locking specifies how to lock the row after performing the operation.

function Table_Exists
         (  Command    : access ODBC_Command;
            Table_Name : String
         )  return Boolean;
function
Table_Exists
         (  Command    : access ODBC_Command;
            Table_Name : Wide_String
         )  return Boolean;

These functions return true if a table with the specified name exists in the data base. The parameter Command is scratch command to use in the operation. Note that the driver may consider table names case-sensitive in some cases and case-insensitive in others. When searching for a table using this function, the table name must be in the canonic form, otherwise the driver may fail finding it.

16.8.7. Binding parameters

The package ODBC.Bound_Parameters defines types used to pass values to prepared commands. Parameters of fixed-size values are bound using an object which type is declared in the package as follows:

type <parameter-type>_Parameter is record
   Size  : aliased SQLLEN;
   Value : aliased <parameter-type>;
end record;

For example, for binding an SQLINTEGER a pointer to a SQLINTEGER_Parameter is passed to Bind_Parameter. The field Value must be set to the desired value before a call to Execute. The following data types (defined in the package ODBC.SQLTypes) are supported:

Parameters for string types are declared with the discriminant Length specifying the maxumum length of the contained string value:

type String_Parameter (Length : size_t) is record
   Size  : aliased SQLLEN := 0;
   Value : aliased char_array (0..Length);
end record;
type Wide_String_Parameter (Length : size_t) is record
   Size  : aliased SQLLEN := 0;
   Value : aliased SQLWCHAR_Array (0..Length);
end record;

For these types the following functions are defined:

function Create (Value : <parameter-type>)
   return <parameter-type>_Parameter;

These functions return parameter type initialized by Value. For example, here is how bound parameters can be initialized:

declare
   Command  : aliased ODBC_Command (Connection'Access);
   ID       : aliased SQLINTEGER_Parameter := Create (24);
   Customer : aliased String_Parameter     := Create ("John");
begin

   Prepare
   (  Command,
      String'("INSERT INTO my_table VALUES (?,?)")
   );
   Bind_Parameter (Command, 1, ID'Access);
   Bind_Parameter (Command, 2, Customer'Access);
   Execute (Command);
end;

For the type SQL_TIMESTAMP_STRUCT_Parameter the following operation is defined:

procedure Set
          (  Parameter : in out SQL_TIMESTAMP_STRUCT_Parameter;
             Value     : Time
          );

This procedure sets the Value field of Parameter to a value corresponding to the time specified by the parameter Value.

procedure Set
          (  Parameter : in out String_Parameter;
             Value     : String
          );

This procedure sets the Value field of Parameter to a value corresponding to Value. Constraint_Error is propagated when Value is larger than the discriminant Length.

procedure Set
          (  Parameter : in out Wide_String_Parameter;
             Value     : Wide_String
          );

This procedure sets the Value field of Parameter to a value corresponding to Value. Constraint_Error is propagated when Value is larger than Length.

[Back][TOC][Next]

16.9. GNUTLS bindings

The package GNUTLS provides bindings to the GNUTLS library. The bindings are semi-thick. Where possible the objects requiring initialization and finalization are wrapped into controlled types. Thus there is no explicit calls to functions like gnutls_init because they are called automatically. The return codes are handled by the bindings and a TLS_Error exception is propagated with the corresponding message text. The original error code can be obtained from the exception occurrence using the function:

function Get_Error_Code (Error : Exception_Occurrence) return int;

The naming of bound subprograms and data types follows the rules:

Where GNUTLS supports a user-defined void * data parameter, a controlled type is used with an abstract primitive operation instead of callbacks, i.e. the visitor pattern. Where GNUTLS does not have user data parameter, a generic package is used with a formal procedure used as a callback.

Where possible the parameters of the type Datum_t are replaced with Stream_Element_Array or String as appropriate.

[Back][TOC][Next]

16.10. Interfacing Julia language

The package Julia provides interfacing with the Julia language. Julia is a scripting language which can be considered as an alternative to deploying Python in Ada projects. Note that Julia uses garbage collection for memory management. This might be undesirable for some application.

The bindings are dynamic so that the bindings can be used on demand. The following is a hello-world example in Julia called from Ada program using the bindings:

File hello_julia.adb:
with Julia; use Julia;

procedure Hello_Julia is
  
Bin : constant String := "D:\Julia-1.4.0\bin";
begin
   Load (Bin & "\libjulia.dll"); -- Load library
   Init_With_Image (Bin);        -- Initialize environment

   Eval_String ("println(""Hello Julia!"")");

   AtExit_Hook;                  -- Finalize environment
end Hello_Julia;

In this example the procedure Load loads the library located at D:\Julia-1.4.0\bin\libjulia.dll. The second call is initialization of Julia's environment using Init_With_Image. It specifies the path where Julia binaries are located. After this Julia can be used. The call

Eval_String ("println(""Hello Julia!"")");

evaluates the argument println("Hello Julia!") that prints Hello Julia! The last line is a call to AtExit_Hook which is used to finalize Julia's environment.

16.10.1. Initialization and finalization

The first call to be done before using any other is Load which loads the Julia's dynamic library.

procedure Load (Name : String := "");

This procedure loads the dynamic library if it is not already loaded. The parameter Name is the library file name. When Name is an empty string, the name returned by the function Julia.Load_Julia_Library.Get_Default_Name is used. It is relative so Julia's binaries must be in the system search path used by the loader. Use_Error is propagated on loading error.

procedure Init;
procedure
Init_With_Image
          (  Julia_Bin_Dir       : String := "";
             Image_Relative_Path : String := ""
          );

One of these two procedures is used after loading the Julia's dynamic library in order to initialize the environment. The variant Init tries to guess where Julia is located. Unfortunately it does this wrong most of the time. The variant Init_With_Image allows specification of the directory where Julia binaries are located. This is normally the directory where Julia's relocated library sits. The parameter Image_Relative_Path is a path relative to Julia_Bin_Dir to the Julia's image relocatable library. Under Windows it is usually ..\lib\julia\sys.dll. Under Linux it is julia/sys.so. When either Julia_Bin_Dir or Image_Relative_Path are empty strings they are guessed. In the case of Image_Relative_Path the function Julia.Load_Julia_Library.Get_Default_Relative_Path is used for the purpose.

procedure AtExitHook;

This procedure is called last to finalize the Julia environment.

16.10.2. Data types

The package Julia declares the following data types:

type function_t is private;
type datatype_t is private;
type module_t   is private;
type value_t    is private;

Objects of these types correspond to Julia's function, data type, module and value.

type values_array is
   array
(Positive range <>) of aliased value_t;
type datatypes_array is
   array
(Positive range <>) of aliased datatype_t;

These are arrays of Julia values and Julia data types. Additionally:

Julia_Error : exception;

This is an exception used when a Julia's exception to propagate in Ada.

No_Value : constant value_t;

The constant corresponding to no value. The following operations are defined for types introspection:

function Equal (Left, Right : datatype_t) return Boolean;

The result is true if two types are equal.

function Is_A (Left, Right : datatype_t) return Boolean;

The result is true if Left is a subtype of Right.

function Is_Mutable (Type_Object : datatype_t) return Boolean;

The result is true if Type_Object is a mutable datatype.

function More_Specific (Left, Right : datatype_t) return Boolean;

The result is true if Left is a more specific type than Right.

function TypeName (Type_Object : datatype_t) return String;
function TypeName (Value : value_t) return String;

These functions return the type name either from the type or from its instance.

function TypeOf (Value : value_t) return datatype_t;

This function returns the type of the object.

function TypeOf_Str (Value : value_t) return String;

This function is an equivalent of TypeName.

16.10.3. Correspondence between data types

Types are objects in Julia. These objects have the type datatype_t in Ada. The following table lists functions returning the corresponding datatype_t objects in the first column and the corresponding Ada type in the second column if applies:

Function Ada type Conversion to Ada Conversion to Julia
Any_Type - - -
Anytuple_Type values_array Value To_Julia
Array_Type - - -
Bool_Type Boolean Value To_Julia
Char_Type Interfaces.C.char
Character
- To_Julia
Datatype_Type - - -
Float32_Type Interfaces.C_float Value To_Julia
Float64_Type Interfaces.C.double Value To_Julia
Int8_Type Interfaces.Integer_8 Value To_Julia
Int16_Type Interfaces.Integer_16 Value To_Julia
Int32_Type Interfaces.Integer_32 Value To_Julia
Int64_Type Interfaces.Integer_64 Value To_Julia
Method_Type - - -
Module_Type - - -
Namedtuple_Type Tuple Value To_Julia
Simplevector_Type - - -
String_Type String Value To_Julia
UInt8_Type Interfaces.Unsigned_8 Value To_Julia
UInt16_Type Interfaces.Unsigned_16 Value To_Julia
UInt32_Type Interfaces.Unsigned_32 Value To_Julia
UInt64_Type Interfaces.Unsigned_64 Value To_Julia
Uniontype_Type - - -

For example, for the type Float32 in Julia there is

function Float32_Type return datatype_t;

This function return the Julia type object for Float32.

function Value (Object : value_t) return C_Float;

This function converts Julia's value of the type Float32 to Interfaces.C.C_Float.

function To_Julia (Value : C_Float) return value_t;

This function converts Interfaces.C.C_Float to a new Julia value.

16.10.4. Julia tuples

A tuple in Julia is an ordered set of values which can be of any type. A tuple can be named in which case each element of the tuple has a unique string key. The tuple interface is supported by some non-tuple types that also have fields.

function Get_Field
         (  Container : value_t;
            Index     : Positive
         )  return value_t;

This function returns element by its index 1... Constraint_Error is propagated on subscript errors.

function Get_Field
         (  Container : value_t;
            Key       : String
         )  return value_t;

Thsi function returns element by its key. Constraint_Error is propagated on subscript errors, e.g. when there is no such key.

function Get_Name
         (  Container : datatype_t / value_t;
            Index     : Positive
         )  return String;

This function returns the element's name by its index 1... Container can be either an object or a type of. Constraint_Error is propagated when there is no such element.

function Is_Defined
         (  Container : value_t;
            Index     : Positive
         )  return Boolean;

This function returns true if the element at the is defined. Constraint_Error is propagated when there is no such element.

function Is_NamedTuple (Object : datatype_t) return Boolean;
function Is_NamedTuple (Object : value_t   ) return Boolean;

These functions return true if the parameter is a named tuple or of named tuple type. Note that for a plain tuple the result is false.

function Is_Tuple (Object : datatype_t) return Boolean;
function Is_Tuple (Object : value_t   ) return Boolean;

These functions return true if the parameter is a tuple or of tuple type. Note that for a named tuple the result is false.

function N_Fields
         (  Container : value_t
         )  return Natural;

This function returns the number of elements.

procedure Set_Field
          (  Container : value_t;
             Index     : Positive;
             Element   : value_t
          )  return Natural;

This procedure set an element by its index 1... Constraint_Error is propagated on subscript errors. Note that this procedure cannot be used with tuples which are immutable.

type Tuple is tagged private;

This type is used as a counterpart to Julia's named tuples. The following operations are defined on the type:

procedure Add
          (  List  : in out Tuple;
             Name  : String;
             Value : value_t
          );

This procedure adds a new element to the tuple. Name is the element name UTF-8 encoded. It must be a valid Julia identifier, otherwise Constraint_Error is propagated. It is also propagated when the tuple already contains an element with this name. Value is the element value. Constraint_Error is also propagated when Value is No_Value.

function Get_Name (List : Tuple; Index : Positive) return String;

This function returns the element name at the position Index. Constraint_Error is propagated when Index is greater than tuple length.

function Get_Value (List : Tuple; Index : Positive) return value_t;

This function returns the element value at the position Index. Constraint_Error is propagated when Index is greater than tuple length.

function Length (List : Tuple) return Natural;

This function returns the number elements of the tuple.

16.10.5. Julia arrays

Julia has built-in arrays with elements of scalar values. These can be accessed from Ada and converted to Ada arrays. The following operations are defined on Julia arrays:

function Dimension (Object : value_t) return Natural;

This function returns the array dimension. Constraint_Error is propagated when the parameter is not an array.

function Element (Object : value_t) return value_t;

This function returns the type of the array elements. Constraint_Error is propagated when the parameter is not an array.

function Is_Array (Object : datatype_t) return Boolean;
function Is_Array (Object : value_t   ) return Boolean;

These functions return true if the parameter is an array type or an array.

function Length
         (  Object    : value_t;
            Dimension : Positive
         )  return Natural;

This function returns the array length for the specified Dimension. Constraint_Error is propagated when the parameter is not an array or Dimension is invalid.

For 1/2/3-D arrays there are generic packages Julia.Generic_1D_Array, Julia.Generic_2D_Array, Julia.Generic_3D_Array.

16.10.6. Execution of Julia code

The Julia effect code execution is accumulated in the environment and held between calls. There is no notion of a block, any sequence of statements can be executed, though it must be a complete statement or expression. The following subroutines are provided for execution of Julia code:

function Eval_String (Str : String) return value_t;
procedure
Eval_String (Str : String);

This function returns the result of evaluation of Str. The procedure variant ignores the result. Julia_Error is propagated if an exception is raised in Julia. Multiple lines of Julia code can be evaluated using semicolon as the line separator. For example, this function declaration in Julia

function inc(arg)
   arg + 1
end

can be evaluated as

Eval_String ("function inc(arg); arg + 1; end")

Julia code can also be loaded from a file:

function Load (Module : module_t; File : String) return value_t;

This function loads Julia code from the file specified by its name File into the module specified by Module. Julia_Error is propagated if an exception is raised in Julia. The following modules are available as the result of the function calls:

function Base_Module return module_t;
function Core_Module return module_t;
function Main_Module return module_t;
function Top_Module  return module_t;

A Julia function can be called directly without loading any code:

function Call
         (  Func      : function_t;
            Arguments : values_array
         )  return value_t;

This function executes Julia function Func passing arguments from the array Arguments and return the result. Julia_Error is propagated if an exception is raised in Julia. The function object can be obtained using Get_Function. There are simplified variants with a fixed number of arguments:

function Call
         (  Func : function_t
         )  return value_t;
function Call
         (  Func     : function_t;
            Argument : value_t
         )  return value_t;
function Call
         (  Func       : function_t;
            Argument_1 : value_t;
            Argument_2 : value_t
         )  return value_t;
function Call
         (  Func       : function_t;
            Argument_1 : value_t;
            Argument_2 : value_t;
            Argument_3 : value_t
         )  return value_t;;

The following example illustrates calling function sqrt from the Julia's base module:

File function_call.adb:
with Ada.Text_IO;   use Ada.Text_IO;
with
Interfaces.C;  use Interfaces.C;
with
Julia;         use Julia;

procedure Function_Call is
begin

   Load ("D:\Julia-1.0.3\bin\libjulia.dll"); -- Load library
   Init_With_Image ("D:\Julia-1.0.3\bin");   -- Initialize environment

   declare
      Sqrt : constant function_t := Get_Function (Base_Module, "sqrt");
      X, Y : Double;
   begin
      X := 4.0;
      Y := Value (Call (Sqrt, (1 => To_Julia (X))));
      Put_Line ("Y =" & Double'Image (Y));
   end;

   AtExit_Hook;                              -- Finalize environment
end Function_Call;

The function to get Julia function object is:

function Get_Function
         (  Module : module_t;
            Name   : String
         )  return function_t;

This function returns the function object in Module with the name specified by Name. End_Error is propagated when there is no function with this name in the module.

16.10.7. Calling Ada from Julia

Julia uses C calling convention when it calls alien code. Therefore Ada subroutines called from Julia must have C conventions. The subroutines are called using Julia function ccall. Though Julia documentation orders to use a dynamic library in ccall, we will ignore that advise, and call Ada code where it is. The following helper function is used for that:

function CCall_Address (Location : Address) return String;

This function returns the Julia expression for the first argument of ccall to call Ada function which address is Location. The following same code illustrates calling an Ada subprogram from Julia:

File ada_call.adb:
with Ada.Text_IO;   use Ada.Text_IO;
with
Interfaces.C;  use Interfaces.C;
with
Julia;         use Julia;

procedure Ada_Call is
begin

   Load ("D:\Julia-1.0.3\bin\libjulia.dll"); -- Load library
   Init_With_Image ("D:\Julia-1.0.3\bin");   -- Initialize environment

   declare
      function Increment (X : Double) return Double;
      pragma Convention (C, Increment);

      function Increment (X : Double) return Double is
      begin
         return
X + 1.0;
      end Increment;
   begin
       Eval_String
       (  "println(ccall("
       &  CCall_Address (Increment'Address)
       &  ",Cdouble,(Cdouble,),10.0))"
       );
   end;

   AtExit_Hook;                              -- Finalize environment
end Ada_Call;

Here the Julia code to execute is:

println(ccall(<increment>,Cdouble,(Cdouble,),10.0))

In place of <increment> the result of CCall_Address (Increment'Address) is placed.

A call to ccall can be wrapped into a Julia function if has to be called repeatedly or when it should look like a normal Julia function. The following code illustrates the case:

File ada_wrapper.adb:
with Ada.Text_IO;   use Ada.Text_IO;
with
Interfaces.C;  use Interfaces.C;
with
Julia;         use Julia;

procedure Ada_Wrapper is
begin

   Load ("D:\Julia-1.0.3\bin\libjulia.dll"); -- Load library
   Init_With_Image ("D:\Julia-1.0.3\bin");   -- Initialize environment

   declare
      function Increment (X : Double) return Double;
      pragma Convention (C, Increment);

      function Increment (X : Double) return Double is
      begin
         return
X + 1.0;
      end Increment;
   begin
      Eval_String
      (  "function Increment(x::Cdouble); ccall("
      &  CCall_Address (Increment'Address)
      &  ",Cdouble,(Cdouble,),x); end"
      );

      Eval_String ("x = 1.0");
      Eval_String ("x = Increment(x)");
      Eval_String ("x = Increment(x)");
      Eval_String ("x = Increment(x)");
      Eval_String ("println(x)");
   end;

   AtExit_Hook;                              -- Finalize environment
end Ada_Wrapper;

In this example a Julia wrapper is declared for the Ada function Increment. The wrapper is also called Increment and then called three times applied to the variable initialized by 1.0. The result is 4.0 is printed at the end.

16.10.8. Handling Julia exceptions

The following subroutines are used for handling exceptions in Julia.

procedure Check_Error (Error : Exception_ID := Julia_Error'Identity);

This procedure checks if there is a Julia exception pending and if so propagates Ada exception Error clearing the Julia exception state. The exception message is taken from the Julia exception.

function Exception_Occurred return Boolean;
function Exception_Occurred return String;

These functions check if a Julia exception is pending. If so the result of Boolean function is true, the result of the string function is exception name. Otherwise it is false and empty string.

procedure Clear_Exception;

This procedure clear pending Julia exception if any.

The following procedures are used to raise Julia exception:

procedure Bounds_Error (Container, Index : value_t);
procedure Error (Text : String);
procedure Too_Few_Args  (Name : String; Min : int);
procedure Too_Many_Args (Name : String; Max : int);
procedure Type_Error
          (  Name     : String;
             Expected : value_t;
             Got      : value_t
          );

16.10.9. 1-d arrays

The package Julia.Generic_1D_Array provides interfacing to 1-d arrays:

generic
   type
Index_Type is range <>;
   type Element_Type is private;
   type Element_Array_Type is
      array
(Index_Type range <>) of Element_Type;
   with function Julia_Type return datatype_t;
package Julia.Generic_1D_Array is ...

The formal parameter of the package are:

Julia arrays have the design similar to Ada. Array elements are kept in a dense buffer and accessed directly by reference. The package must be used carefully, if the length of the implied element type does not correspond to the actual element length, access to array element may lead to memory corruption.

The package declares the following subroutines:

function Get
         (  Object   : value_t;
            Position : Positive
         )  return Element_Type;

This function returns array element by its position 1... Constraint_Error is propagated when Position is out of range.

function Length (Object : value_t) return Natural;

This function returns the number of elements in the array.

procedure Set
          (  Object   : value_t;
             Position : Positive;
             Element  : Element_Type
          );

This procedure sets array element at Position 1... Constraint_Error is propagated when Position is out of range.

function To_Julia (Value : Element_Array_Type) return value_t;

This function creates a new Julia arrays from the parameter Value.

function Value (Object : value_t) return Element_Array_Type;

This function returns Ada array corresponding to Julia's Object.

The following same illustrates usage of the package:

File array_1d.adb:
with Ada.Text_IO;   use Ada.Text_IO;
with
Interfaces.C;  use Interfaces.C;
with
Julia;         use Julia;

with Julia.Generic_1D_Array;

procedure Ada_Wrapper is
   type
Words_Array is
      array
(Positive range <>) of Interfaces.Integer_16;
   package
Words_Arrays is
      new
Julia.Generic_1D_Array
          (  Index_Type         => Positive,
             Element_Type       => Interfaces.Integer_16,
             Element_Array_Type => Words_Array,
             Julia_Type         => Int16_Type
          );
begin

   Load ("D:\Julia-1.0.3\bin\libjulia.dll"); -- Load library
   Init_With_Image ("D:\Julia-1.0.3\bin");   -- Initialize environment

   declare
      use Words_Arrays;
      A : value_t;
   begin
      A := Eval_String ("a = [Int16(1), Int16(2), Int16(3)]");
      Put ("A =");
      for Index in 1..Length (A) loop
         Put (Interfaces.Integer_16'Image (Get (A, Index)));
      end loop;
      New_Line;
      Set (A, 2, 10);
      Eval_String ("println(a)");
   end;

   AtExit_Hook;                              -- Finalize environment
end Ada_Wrapper;

The same creates an array of 16-bit integer in Julia. The array is printed in Ada. Its second element is updated and finally the array is printed in Julia. The output may look like this:

A = 1 2 3
Int16[1, 10, 3]

16.10.10. 2-d arrays

The package Julia.Generic_2D_Array provides interfacing to 2-d arrays:

generic
   type
Row_Index_Type is range <>;
   type Column_Index_Type is range <>;
   type Element_Type is private;
   type Element_Array_Type is
      array
(Row_Index_Type range <>, Column_Index_Type range <>)
         of Element_Type;
   with function Julia_Type return datatype_t;
package Julia.Generic_1D_Array is ...

The formal parameter of the package are:

The package declares the following subroutines:

function Columns (Object : value_t) return Natural;

This function returns the number of columns in the array.

function Get
         (  Object : value_t;
            Row    : Positive;
            Column : Positive
         )  return Element_Type;

This function returns array element by its row and column positions starting from 1. Constraint_Error is propagated when Row or Column is out of range.

function Rows (Object : value_t) return Natural;

This function returns the number of rows in the array.

procedure Set
          (  Object  : value_t;
             Row     : Positive;
             Column  : Positive
             Element : Element_Type
          );

This procedure sets array element specified by its row and column positions starting from 1. Constraint_Error is propagated when Row or Column is out of range.

function To_Julia (Value : Element_Array_Type) return value_t;

This function creates a new Julia arrays from the parameter Value.

function Value (Object : value_t) return Element_Array_Type;

This function returns Ada array corresponding to Julia's Object.

16.10.11. 3-d arrays

The package Julia.Generic_3D_Array provides interfacing to 3-d arrays:

generic
   type
X_Index_Type is range <>;
   type Y_Index_Type is range <>;
   type Z_Index_Type is range <>;
   type Element_Type is private;
   type Element_Array_Type is
      array
(Row_Index_Type range <>, Column_Index_Type range <>)
         of Element_Type;
   with function Julia_Type return datatype_t;
package Julia.Generic_1D_Array is ...

The formal parameter of the package are:

The package declares the following subroutines:

function Get
         (  Object  : value_t;
            X, Y, Z : Positive;
            Column  : Positive
         )  return Element_Type;

This function returns array element by its X, Y, Z positions starting from 1. Constraint_Error is propagated when either of the positions is out of range.

procedure Set
          (  Object  : value_t;
             X, Y, Z : Positive;
             Element : Element_Type
          );

This procedure sets array element specified by its X, Y, Z positions starting from 1. Constraint_Error is propagated when either of the positions is out of range.

function To_Julia (Value : Element_Array_Type) return value_t;

This function creates a new Julia arrays from the parameter Value.

function Value (Object : value_t) return Element_Array_Type;

This function returns Ada array corresponding to Julia's Object.

function X_Length (Object : value_t) return Natural;
function
Y_Length (Object : value_t) return Natural;
function
Z_Length (Object : value_t) return Natural;

This function returns the number of array element for the corresponding dimension.

16.10.12. Garbage collection control

Julia deploys garbage collection. The following subroutines are provided to control it:

procedure GC_Collect (Full : Boolean := True);

This procedure invokes the collector. When Full is false the collection is partial. Otherwise it is full.

function GC_Diff_Total_Bytes return Integer_64;

This function returns the number of leftover bytes.

function GC_Enable (On : Boolean) return Boolean;

This function turns collection on or off. The result is the collection state prior to the call.

function GC_Is_Enabled return Boolean;

This function returns true if collection is enabled.

function GC_Total_Bytes return Integer_64;

This function returns the total number of bytes.

procedure GC_WB (Parent, Child : value_t);

This procedure is used to inform the collector the Parent was updated to contain Child. WB stands for write barrier.

The collector can be potentially called on every creation of a new Julia object. It means that a value returned from Julia can become a dangling reference if not referenced in Julia environment. Such variables must be protected from collection. For example this code

declare
   X : value_t;
   Y : value_t;
begin
   X := Eval_String ("sqrt(2.0)";
   Y := Eval_String ("sqrt(3.0)";

is erroneous because the object referenced by X can be collected when Y is evaluated. In order to protect X a special object can be used this way:

declare
   X : value_t;
   Y : value_t;
begin
   X := Eval_String ("sqrt(2.0)";
   declare
      Root : Holder (1); -- Can hold one object
   begin
      Set (Root, X); -- X is "rooted" to the end of the scope
      Y := Eval_String ("sqrt(3.0)";
   end;

The type is declared as follows:

type Holder (Count : Positive) is tagged limited private;

The discriminant Count specifies how many objects can be kept by the object. One of the following operations must be called once to set the objects:

procedure Set
          (  Object : in out Holder;
             Value  : value_t / datatype_t
          );
procedure
Set
          (  Object  : in out Holder;
             Value_1 : value_t;
             Value_2 : value_t
          );
procedure
Set
          (  Object  : in out Holder;
             Value_1 : value_t;
             Value_2 : value_t;
             Value_3 : value_t
          );

These procedures set values to protect into the Object. Use_Error is propagated when one of these procedures was already called. Constraint_Error is propagated when Object cannot hold so many values.

procedure Set
          (  Object : in out Holder;
             Slot   : Positive;
             Value  : value_t / datatype_t
          );

This procedure can be used to set protected values sequentially, e.g. from a loop. Use_Error is propagated when Slot has already a value to protect. Constraint_Error is propagated when Slot is greater than Object.Count.

[Back][TOC][Next]

16.11. OpenSSL bindings

The package OpenSSL provides bindings to the OpenSSL library. The bindings are semi-thick. The bindings are not complete, basically only operations directly used for maintaining SSL/TLS connections are provided.

 

[Back][TOC][Next]

16.12. Universally unique identifiers

The package Universally_Unique_Identifiers provides means to generate Universally Unique Identifiers (UUID) as described in RFC 4122. The following data types are defined:

type UUID_Value is array (1..16) of Byte;

This is the type of UUID values. Each value is 128-bit long.

subtype UUID_String is String (1..36);

The subtype UUID_String represents an UUID in textual form like 6068bed1-f90c-3d44-4231-0d62bc164d19.

subtype Node_ID is String (1..6);

The node identification subtype is used when UUID is generated from a time-stamp. The following operations are provided:

function Create return UUID_Value;

This function generates an UUID using pseudo-random numbers.

function Create
         (  ID    : Node_ID;
            Stamp : Time := Clock
         )  return UUID_Value;

This function generates an UUID from time stamp. The parameter ID is provided to identify the node, e.g. the MAC address as the standard suggests.

function "<"  (Left, Right : UUID_Value) return Boolean;
function
"<=" (Left, Right : UUID_Value) return Boolean;
function
">=" (Left, Right : UUID_Value) return Boolean;
function
">"  (Left, Right : UUID_Value) return Boolean;

Comparison functions treat UUID as a big-endian number. The order is compatible with the UUID order in textual representation.

16.12.1. String editing

The package Universally_Unique_Identifiers.Edit provides string formatting facilities for UUID.

procedure Get
          (  Source  : String;
             Pointer : in out Integer;
             Value   : out UUID_Value
          );

This procedure takes Value starting from Source (Pointer). Pointer is advanced after the input. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there is no UUID. Data_Error is propagated on UUID format errors.

function Image (Value : UUID_Value) return UUID_String;

This function returns the textual representation of UUID.

procedure Put
          (  Destination : in out String;
             Pointer     : in out Integer;
             Value       : UUID_Value;
             Field       : Natural   := 0;
             Justify     : Alignment := Left;
             Fill        : Character := ' '
          );

This procedure outputs Value starting from Destination (Pointer). Pointer is advanced after the output. Field, Justify and Fill control output. Layout_Error is propagated when there is no room for output or Pointer is invalid.

function Value (Source : String) return UUID_Value;

This function converts the textual representation of UUID to its value. Data_Error is propagated on format errors.

[Back][TOC][Next]

16.13. Interfacing Python language

The package Py provides interfacing with the Python language. Python is a popular scripting language.

The bindings are dynamic so that it can be used on demand without imposing a dependency on any external library. The following is a hello-world example in Python called from Ada program using the bindings:

File hello_julia.adb:
with Ada.Characters.Latin_1;  use Ada.Characters.Latin_1;
with
Ada.Text_IO;             use Ada.Text_IO;
with Interfaces.C;            use Interfaces.C;
with Py;                      use Py;

with Py.Load_Python_Library;

procedure Hello_Python is
begin

   Load -- Load library
   (  Load_Python_Library.Get_Python_Path
   &  Load_Python_Library.Get_Default_Name
   );
   Initialize; -- Initialize environment
   declare
      GIL    : Global_Interpreter_Lock;
      Hello  : Handle;
      Args   : Handle;
      Result : Handle;
   begin
      -- Compile Python source and find entry point in there
      Hello :=
         Compile
         (  "def Hello(s):" & LF & "   print (""Hello ""+s+'!')",
            "hello.py"
         );
      -- Create argument list
      Args := Tuple_New (1);
      Tuple_SetItem (Args, 0, Unicode_FromString ("Python"));
      -- Make a call to Hello
      Result := Object_CallObject (Hello, Args, True);
   end;
   if FinalizeEx < 0 then -- Finalize environment
      Put_Line ("Python finalization error");
   end if;
end Hello_Python;

The naming conventions of the subprograms follow the names of the corresponding function of Python/C API with the prefix Py or Py_ removed. E.g. the API function PyTuple_SetItem is named Tuple_SetItem in the bindings. The bindings provide high-level conversions to Python from Ada and back with exception handling and reference counting. The private part of the package also provides direct bindings to Python vectorized by the structure Links initialized when the Python dynamic library is loaded. Therefore Links.PyTuple_SetItem would be a direct API function call with C arguments and C convention.

Additionally the Python datetime capsule is automatically loaded and conversions between the Python datetime.datetime objects and Ada.Calendar.Time are provided.

16.13.1. Initialization and finalization

The bindings are dynamic and do not impose any dependency on Python libraries. Before anything else, a Python dynamic library must be loaded:

procedure Load (Name : String := "");

The parameter Name specifies the library path. Under Windows Python location is tricky. The child package Py.Load_Python_Library provides helper function to search for the Python installation:

function Get_Default_Name (Major : Natural := 7) return String;

This function returns the default name of the Python dynamic library. Under Windows it is python3.dll. Under Linux where the name is not fixed it scans system library folders for libpython3.n*.so.*. The number n must be at least Major. If no library found the result is libpython3.so.

function Get_Extension return String;

This function returns the dynamic library extension, e.g. "*.dll" or "*.so".

function Get_Python_Path (Major : Natural := 7) return String;

This function returns the Python installation path following the directory separator if not empty. The parameter Major specifies the minimal major version required, e.g.3.7 by default. Under Linux it returns empty string as Python is expected to be on the standard library path.

function Is_Loaded return Boolean;

This function returns true if the Python dynamic library is loaded.

After the library is loaded it must be initialized by the following procedure from the package Py:

procedure Initialize;

Before unloading the library it must be finalized:

function FinalizeEx return int;

This function from the package Py returns negative value on errors.

The Python bindings frame is as follows:

  1. Load in order to load the Python dynamic library
  2. Loading custom modules into the Python environment
  3. Initialize to make the Python environment ready
  4. Calling other subprograms from the bindings while taking the Global Interpreter Lock
  5. FinalizeEx to finalize the Python environment and free any resources allocated by it

16.13.2. Tasking

Python is not multi-tasking, only one instance of the interpreter may run at a time. The interlocking in Python is enforced by the Global Interpreter Lock (GIL) and thread-local data. The package provides a controlled object to acquire the lock when Python subprograms need to be called:

type Global_Interpreter_Lock is
   new
Ada.Finalization.Limited_Controlled with private;

An instance of the type is declared in a block where Python bindings are accessed. It can be used in any Ada task.

procedure Request_Abort;

This procedure is called outside Global Interpreter Lock to queue exception SystemError to abort pending Python execution by another task.

16.13.3. Handles to objects

Where C API deploy a reference to PyObject the binding use the type Handle declared as

type Handle is new Ada.Finalization.Controlled with private;

The objects of the type take care of Python reference counting transparently.

procedure Check_Handle (Object : Handle);

This procedure checks if Object is a valid and raises Python_Error exception if it is not while setting a corresponding Python exception pending.

procedure Invalidate (Object : Handle);

This procedure invalidates a handle. If it was valid the reference of the corresponding Python object is decremented.

function No_Value return Handle;

This function returns the handle of the Python no-value object returned by procedures as the result to indicate successful execution.

16.13.4. Exceptions

The following subprograms are used to handle Python exceptions:

procedure Check_Error;

This procedure propagates Python_Error exception if there is a Python exception pending.

procedure Err_Clear;

This procedure clears pending Python exception if there is any.

function Err_Occurred return Handle;

This function returns a handle to the pending Python exception object. If there is none the result is an invalid handle.

procedure Error_Traceback
          (  Destination : in out String;
             Pointer     : in out Integer;
             No_Error    : out Boolean;
             Decorator   : String := Character'Val (13) &
                                     Character'Val (10) &
                                     "   ";
             Clear_Error : Boolean := True
          );

This procedure stores pending Python exception traceback into the Destination string starting at Pointer. Upon successful completion Pointer is advanced to the next position. No_Error is set to true if there is no exception pending no output made. Otherwise it is set to false. Decorator is the text used as a prefix of each frame of the traceback. Clear_Error if true removes the exception on successful completion. Layout_Error is propagated when Pointer is invalid or there is no room for output.

function Is_Err_Occurred return Boolean;

This function returns true if there is a pending Python exception.

procedure Reraise_As (ID : Exception_ID);

If a Python exception is pending it is cleared and Ada's ID exception is raised instead.

procedure Throw_KeyError        (Message : String);
procedure Throw_LookupError     (Message : String);
procedure Throw_NameError       (Message : String);
procedure Throw_PermissionError (Message : String);
procedure Throw_RunTimeError    (Message : String);
procedure Throw_TimeoutError    (Message : String);
procedure Throw_SyntaxError     (Message : String);
procedure Throw_TypeError       (Message : String);
procedure Throw_ValueError      (Message : String);

These procedures are used to set a Python exception.

procedure Throw_SystemError (Error : Exception_Occurrence);

This procedure converts Ada exception into Python SystemError exception.

16.13.5. Executing Python from Ada

The following subprograms are used to run Python scripts from Ada:

function Compile
         (  Source    : String;
            File_Name : String
         )  return Handle;

This function compiles a Python source in Source and returns a handle to the executable result. The parameter File_Name is the name of a "file" to associate with the source. The source must contain a function to be executed. Data_Error is propagated when no definition is found.

procedure Compile
          (  Source      : String;
             File_Name   : String;
             Module      : out Handle;
             Entry_Point : out Handle
          )  return Handle;

This procedure is like the function above, but also returns a handle to the compiled module object.

function Object_Call
         (  Operation : Handle;
            Arguments : Handle;
            Keyed     : Handle;
            Check     : Boolean := False
         )  return Handle;

This function executes a Python executable object Operation. The positional arguments are specified by the parameter Arguments, which must be a handle to a Python tuple. The keyed arguments are specified by the parameter Keyed, which must be a handle to a Python dictionary. If execution fails with an exception and Check is true, Python_Error is propagated. Otherwise the result is invalid handle. On success the result is valid. Note that no result is No_Value.

function Object_CallNoArgs
         (  Operation : Handle;
            Check     : Boolean := False
         )  return Handle;

This function is similar to Object_Call but used for parameterless functions.

function Object_CallObject
         (  Operation : Handle;
            Arguments : Handle;
            Check     : Boolean := False
         )  return Handle;

This function is similar to Object_Call but used for functions with only positional parameters.

function Object_Super
         (  Object : Handle;
            Name   : String
         )  return Handle;

This function returns a handle to the parent's implementation of the method Name, It is equivalent of Object.super().Name.

function Import
         (  File_Name  : String;
            Entry_Name : String
         )  return Handle;

This function imports a Python module in File_Name and returns a handle to an executable function in the module with the name specified by Entry_Name. When the module was already loaded, the loaded version is used. When File_Name contains a path this is added to the Python's path before importing and removed afterwards. When there is no path, the current directory is used as one. If File_Name contains and extension, e.g. ".py", it is removed from the name. Name_Error is propagated when the module name is empty. Mode_Error is propagated when Entry_Name is not callable.

16.13.6. Encapsulation of Ada objects

An Ada object can be transparently passed to Python and back without introducing a new Python type. The generic package:

generic
   type
Object_Type (<>) is private;
package Generic_Capsule is
   type
Object_Type_Ptr is access all Object_Type;

The package is instantiated with an Ada type. The package provides the following subprograms:

function Create (Value : Object_Type) return Handle;

This function creates a new capsule that contains Value and returns a handle to it.

function Get (Value : Handle) return Object_Type_Ptr;

This function returns a pointer to the Ada object contained in the capsule Value.

function Is_Valid (Value : Handle) return Boolean;

This function checks if the capsule Value is valid without propagating exceptions.

16.13.7. Creating a Python class

The subdirectory python-examples contains sample code for creating a Python class:

File py-class.ads:
package Py.Class is                                                         
   --
   -- Create_Point_Type -- Create the type and the module
   --
   -- Returns :
   --
   --    The type object
   --

   function Create_Point_Type return Handle;

The function Create_Point_Type creates the type and return a handle to it.

File py-class.ads (continuation):
   --                                                                       
   -- Point -- Contained Ada type                         
   --

   type Point is record
      X : Float;
      Y : Float;
   end record;

The Python objects will contain Ada's Point record. The sample code implements getters and setters for the components X and Y and the method length to calculate the vector length of Point, i.e. sqrt (x2+y2). The object constructor will take  x and y as optional keyed arguments.

File py-class.ads (continuation):
   --                                                                       
   -- Get -- Ada value of the object                      
   --
   --    Object - The Python object
   --
   -- Returns :
   --
   --    The object's contents
   --

   function Get (Object : Handle) return Point;
   --
   -- Set -- Ada value into the object
   --
   --    Object - The Python object
   --    Value  - The value to set into
   --

   procedure Set (Object : Handle; Value : Point);

end Py.Class;

These are two convenience functions to get Ada object from and set it into Python object.

The implementation of the package is as follows:

File py-class.adb:
with System.Storage_Elements; use System.Storage_Elements;                   

with Ada.Numerics.Elementary_Functions;
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;

package body Py.Class is

   function
Get_X
            (  Self    : Object;
               Closure : System.Address
            )  return Object;
   pragma Convention (C, Get_X);

The function Get_X implements getter of X. It must have C convention as it is called from Python.

File py-class.adb (continuation):
   function Get_Y                                                            
            (  Self    : Object;
               Closure : System.Address
            )  return Object;
   pragma Convention (C, Get_Y);

The function Get_Y is just like Get_X.

File py-class.adb (continuation):
   function Length (Self : Object; Arg : Object) return Object;              
   pragma Convention (C, Length);

This the function that implements the length method.

File py-class.adb (continuation):
   function New_Instance                                                     
            (  Class    : Object;
               Args     : Object;
               Keywords : Object
            )  return Object;
   pragma Convention (C, New_Instance);

The is the declaration of the object constructor.

File py-class.adb (continuation):

   function Set_X                                                            
            (  Self    : Object;
               Value   : Object;
               Closure : System.Address
            )  return int;
   pragma Convention (C, Set_X);

   function Set_Y
            (  Self    : Object;
               Value   : Object;
               Closure : System.Address
            )  return int;
   pragma Convention (C, Set_Y);
 

Here we declare the setters for X and Y.

File py-class.adb (continuation):
   function Get (Object : Handle) return Point is                            
   begin

      Check_Handle (Object); -- Not checking the object type because we
      declare                -- do not keep it anywhere
         This : Point;
         pragma Import (Ada, This);
         for This'Address use System.Address (Object.Ptr)
                            + Storage_Offset (Object_HeadSize);
      begin
         return
This;
      end;
   end Get;

The implementation of Get takes a handle to the object. It is checked for being a valid handle first. The next should be checking the type, but it is not shown here because in this simple example we do not store a handle to the type we created anywhere. In a production code Create_Point_Type would keep a handle to it, get the object's actual type and compare either directly or for subtyping.

The next step is getting address of the Ada object. The function Object_HeadSize returns the size of a Python object's base. The Ada object is stored right after it.

File py-class.adb (continuation):
   function Get_X                                                            
            (  Self    : Object;
               Closure : System.Address
            )  return Object is
      This : Point;
      pragma Import (Ada, This);
      for This'Address use System.Address (Self)
                         + Storage_Offset (Object_HeadSize);
   begin
      return
Links.Float_FromDouble (double (This.X));
   exception
      when
Python_Error =>
         return Null_Object;
      when others =>
         Throw_ValueError ("Invalid x");
         return Null_Object;
   end Get_X;

The implementation of X getter obtains Ada object address and then takes its X components and returns Python's float obtained from it. Links is the vector of Python direct bindings. We catch all Ada exceptions and convert them to Python.

File py-class.adb (continuation):
   function Get_Y                                                            
            (  Self    : Object;
               Closure : System.Address
            )  return Object is
      This : Point;
      pragma Import (Ada, This);
      for This'Address use System.Address (Self)
                         + Storage_Offset (Object_HeadSize);
   begin
      return
Links.Float_FromDouble (double (This.Y));
   exception
      when
Python_Error =>
         return Null_Object;
      when others =>
         Throw_ValueError ("Invalid y");
         return Null_Object;
   end Get_Y;

The implementation of Y getter is similar.

File py-class.adb (continuation):
   function Length (Self : Object; Arg : Object) return Object is            
      use Ada.Numerics.Elementary_Functions;
      This : Point;
      pragma Import (Ada, This);
      for This'Address use System.Address (Self)
                         + Storage_Offset (Object_HeadSize);
   begin
      return

         Links.Float_FromDouble (double (Sqrt (This.X**2 +This.Y**2 )));
   exception
      when
Python_Error =>
         return Null_Object;
      when others =>
         Throw_ValueError ("Error in length");
         return Null_Object;
   end Length;

The implementation of length method is like a getter. Note that checking arguments is not required because it advertised as having none and that is checked by Python itself.

File py-class.adb (continuation):
   New_List : constant Argument_List := - "x" - "y";                         

   function New_Instance
            (  Class    : Object;
               Args     : Object;
               Keywords : Object
            )  return Object is
      Result : Object;
   begin
      declare

         List : constant Object_Array :=
                         Parse (Args, Keywords, New_List);
         X, Y : Float := 0.0;
      begin
         if List (1) /= Null_Object then
            X := Float (Links.Float_AsDouble (List (1)));
            Check_Error;
         end if;
         if List (2) /= Null_Object then
            Y := Float (Links.Float_AsDouble (List (2)));
            Check_Error;
         end if;
         Result := -- Allocate the object
            Links.Type_GetSlot (Class, tp_alloc).tp_alloc (Class, 0);
         declare
            This : Point;
            pragma Import (Ada, This);
            for This'Address use System.Address (Result)
                              +  Storage_Offset (Object_HeadSize);
         begin
            This.X := X;
            This.Y := Y;
         end;
      end;
      return Result;
   exception
      when
Constraint_Error =>
         Throw_TypeError ("Argument is out of range");
         return Null_Object;
      when Python_Error =>
         return Null_Object;
   end New_Instance;

The implementation of constructor uses Parse to process the arguments. Both arguments x and y are optional.

File py-class.adb (continuation):
         Result := -- Allocate the object                                    
            Links.Type_GetSlot (Class, tp_alloc).tp_alloc (Class, 0);

The new object is allocated using the type's allocator. Python initializes it for the type unless not told to use custom allocator. The allocator takes the types as the parameter and the number of elements if the object is a container. In this case it is 0.

File py-class.adb (continuation):
         declare                                                             
            This : Point;
            pragma Import (Ada, This);
            for This'Address use System.Address (Result)
                              +  Storage_Offset (Object_HeadSize);
         begin
            This.X := X;
            This.Y := Y;
         end;
      end;
      return Result;
   exception
      when
Constraint_Error =>
         Throw_TypeError ("Argument is out of range");
         return Null_Object;
      when Python_Error =>
         return Null_Object;
   end New_Instance;

Here we get the object address as usual and set Ada fields. The rest is already initialized by Python.

File py-class.adb (continuation):
   procedure Set (Object : Handle; Value : Point) is                         
   begin

      Check_Handle (Object); -- Not checking the object type because we
      declare                -- do not keep it anywhere
         This : Point;
         pragma Import (Ada, This);
         for This'Address use System.Address (Object.Ptr)
                            + Storage_Offset (Object_HeadSize);
      begin
         This := Value;
      end;
   end Set;

The implementation of Set follows the pattern. We take the object address and set it as needed.

File py-class.adb (continuation):
   function Set_X                                                            
            (  Self    : Object;
               Value   : Object;
               Closure : System.Address
            )  return int is
      This : Point;
      pragma Import (Ada, This);
      for This'Address use System.Address (Object.Ptr)
                         + Storage_Offset (Object_HeadSize);
   begin
      This.X := Float (Links.Float_AsDouble (Value));
      return 0;
   exception
      when
Python_Error =>
         return -1;
      when others =>
         Throw_TypeError ("Error setting x");
         return -1;
   end Set_X;

   function Set_Y
            (  Self    : Object;
               Value   : Object;
               Closure : System.Address
            )  return int is
      This : Point;
      pragma Import (Ada, This);
      for This'Address use System.Address (Object.Ptr)
                         + Storage_Offset (Object_HeadSize);
   begin
      This.Y := Float (Links.Float_AsDouble (Value));
      return 0;
   exception
      when
Python_Error =>
         return -1;
      when others =>
         Throw_TypeError ("Error setting y");
         return -1;
   end Set_Y;

The implementation of setters is similar to implementation of getters. The result is int. -1 is used to indicate an error. At this point a Python exception must be set.

File py-class.adb (continuation):
   GetSets : array (1..3) of aliased GetSetDef := -- Must exist when the     
      (  (  Name    => New_String ("x"),          -- type does
            Get     => Get_X'Access,
            Set     => Set_X'Access,
            Doc     => New_String ("x-coordinate"),
            Closure => System.Null_Address
         ),
         (  Name    => New_String ("y"),
            Get     => Get_Y'Access,
            Set     => Set_Y'Access,
            Doc     => New_String ("y-coordinate"),
            Closure => System.Null_Address
         ),
         End_GetSet
      );

Here we describe getters and setters. Each array component defines a pair, provides the name, implementations, documentation and closure to pass with. Note that Python is unclear about which elements of definition structures are copied and which need to be kept. You should experiment to determine what is the case. For getters and setters Python does not copy. So it is declared library-level here. At least it must outlive the type.

File py-class.adb (continuation):

   Methods : array (1..2) of aliased MethodDef :=                            
      (  (  Name  => New_String ("length"),
            Meth  => (False, Length'Access),
            Flags => METH_NOARGS,
            Doc   => New_String ("vector length")
         ),
         End_Method
      );

Methods are defined as getters and setters are. The array elements give the method name, the implementation (which can have only positional or positional-keyed mixture of arguments), flags and documentation string. In this case METH_NOARGS tells that length has no arguments.

File py-class.adb (continuation):

   function Create_Point_Type return Handle is
      Result : Handle;
      Module : Handle;
      Doc    : aliased char_array := "point example" & NUL;
      Slots  : array (1..5) of aliased Type_Slot :=
         (  (tp_doc,     (tp_doc,     To_Chars_Ptr (Doc'Unchecked_Access))),
            (tp_new,     (tp_new,     New_Instance'Access)),
            (tp_getset,  (tp_getset,  GetSets (1)'Unchecked_Access)),
            (tp_methods, (tp_methods, Methods (1)'Unchecked_Access)),
            End_Slot
         );

The implementation of type creation uses an array describing slots of the type we provide. In this case it is documentation, constructor, getters and setters, methods.

File py-class.adb (continuation):

      begin                                                                  
         Result.Ptr :=
            Links.Type_FromSpec
            (  (  Name  => New_String ("point"),
                  Basic_Size =>
                     int (Object_HeadSize + (Point'Size + 7) / 8),
                  Item_Size => 0,
                  Flags => TPFLAGS_DEFAULT + TPFLAGS_HEAPTYPE,
                  Slots => Slots (Slots'First)'Unchecked_Access
            )  );
      if Result.Ptr = Null_Object then
         Check_Error;
      end if;

Here we create the new type giving its basic size and passing slots.

File py-class.adb (continuation):

      Module := Import_AddModule ("point");                                  
      Module_AddObject (Module, "point", Result);
      return Result;
   end Create_Point_Type;

end Py.Class;

For a type to work we need a module which is created here if not already exists. Then the new type is added to the module. The module has the name point. So it can be used as follows:

import point
def Test():
   x = point.point(x=1.0,y=2.0)
   y = point.point()
   print (x.x)
   y.y = 100.0
   print (y.y)
   print ("y length="+str(y.length()))

16.13.8. Parsing Python arguments

The private part of the package provides means to parse Python arguments of functions with positional and keyed arguments.

type Argument_List (<>) is ...;

The type that describes an argument list. The list is constructed using operations "+" and "-":

function "+" (Left : String) return Argument_List;
function
"+" (Left, Right : String) return Argument_List;
function
"+" (List : Argument_List; Key : String) return Argument_List;

These operations add mandatory parameters to the list.

function "-" (Left : String) return Argument_List;
function
"-" (Left, Right : String) return Argument_List;
function
"-" (List : Argument_List; Key : String) return Argument_List;

These operations add optional parameters to the list. So a list can be constructed as follows:

"a" - "b" - "c"

Here a is mandatory and b and c are optional. The list can then be used to parse and validate argument list:

function Parse
         (  Args     : Object;
            Keywords : Object;
            List     : Argument_List
         )  return Object_Array;

The arguments Args and Keywords are the tuple and dictionary as passed from Python to the subprogram. List is the argument list description. On success the result is

type Object is new Address;
Null_Object : constant Object := Object (Null_Address);
type
Argument_Position is new Positive;
type
Object_Array is array (Argument_Position range <>) of Object;

The result has an element for each argument in the order specified by the list. Optional arguments when omitted are stored Null_Object. On an error Python_Error is propagated and a corresponding Python exception is set.

16.13.9. Creating a Python module

The subdirectory python-examples contains sample code for creating a Python module:

File py-module.ads:
package Py.Module is                                                           
--
-- Create -- Create module
--
   procedure Create;

end Py.Module;

The package the single procedure to create the module. The module provides single subprogram operation. The operation takes three arguments a, b, c. integer, string, float. The first is mandatory, the rest are optional.

The implementation of the package is as follows:

File py-class.adb:
with Ada.Exceptions;           use Ada.Exceptions;                             
with Ada.Text_IO;              use Ada.Text_IO;
with System.Storage_Elements;  use System.Storage_Elements;

with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;

package body Py.Module is

   Module_Name    : aliased char_array := "sample_module"        & Nul;
   Module_Doc     : aliased char_array := "sample Python module" & Nul;

   Operation_Name : aliased char_array := "operation"            & Nul;
   Operation_Doc  : aliased char_array := "Test operation"       & Nul;

Here we declare the module and operation name and documentation strings.

File py-class.adb (continuation):

   function Operation                                                          
            (  Self     : Object;
               Args     : Object;
               Keywords : Object
            )  return Object;
   pragma Convention (C, Operation);

The operation is declared according to the argument passing method: METH_VARARGS + METH_KEYWORDS.

File py-class.adb (continuation):

   Operation_Arguments : constant Argument_List := "a" - "b" - "c";                      

The arguments list is declared here. a is mandatory. b and c are optional.

File py-class.adb (continuation):

   function Operation                                                          
            (  Self     : Object;
               Args     : Object;
               Keywords : Object
            )  return Object is
   begin
      declare

         Result : Handle;
         List   : constant Object_Array :=
                           Parse (Args, Keywords, Operation_Arguments);

The implementation of operation starts with parsing arguments using Parse.

File py-class.adb (continuation):

      begin
         Put_Line ("A =" & long'image (Links.Long_AsLong (List (1))));
         if List (2) /= Null_Object then
            Put_Line ("B = " & As_String (List (2)));
         end if;
         if List (3) /= Null_Object then
            Put_Line ("C =" & double'Image (Links.Float_AsDouble (List (3))));
         end if;

The implementation prints its arguments.

File py-class.adb (continuation):

         Result := Unicode_FromString ("OK");                                  
         Links.IncRef (Result.Ptr); -- New reference
         return Result.Ptr;

As the result the string "OK" is returned. Note that Python reference counting excepts reference count incremented by 1 for the result.

File py-class.adb (continuation):

      end;                                                                     
   exception
      when
Python_Error =>
         return Null_Object;
      when Error : others =>
         Throw_SystemError (Error);
         return Null_Object;
   end Operation;

The exception handling is straightforward. On error the result must be Null_Object and a Python exception set.

File py-class.adb (continuation):

   Methods : array (1..2) of aliased MethodDef :=                              
      (  (  Name  => To_Chars_Ptr (Operation_Name'Access),
            Meth  => (True, Operation'Access),
            Flags => METH_VARARGS + METH_KEYWORDS,
            Doc   => To_Chars_Ptr (Operation_Doc'Access)
         ),
         End_Method
      );

Here the module subprograms are declared. The array elements describe each subprogram providing its name, the implementation, the flags specifying argument passing, the documentation.

File py-class.adb (continuation):

   ModuleDef_HEAD_INIT : constant ModuleDef_Base :=                            
      (  Base  => (1, Null_Object),
         Init  => null,
         Index => 0,
         Copy  => Null_Object
      );

   Module : constant ModuleDef :=
      (  Base     => ModuleDef_HEAD_INIT,
         Name     => To_Chars_Ptr (Module_Name'Access),
         Doc      => To_Chars_Ptr (Module_Doc'Access),
         Size     => -1,
         Methods  => Methods (1)'Access,
         Slots    => null,
         Traverse => null,
         Clear    => null,
         Free     => null
      );

This is the rest of module definition that sets the module name, documentation string and subprograms of.

File py-class.adb (continuation):

   function Module_Init return Object;                                         
   pragma Convention (C, Module_Init);

   function Module_Init return Object is
      Result : Object;
   begin
      Result := Module_Create (Module);
      return Result;
   end Module_Init;

The module initialization function creates the module object from its defintion.

ile py-class.adb (continuation):

   procedure Create is                                                         
   begin
      if
0 > Import_AppendInittab
             (  Module_Name,
                Module_Init'Access
             )
      then
         Raise_Exception
         (  Python_Error'Identity,
            "Cannot append test module"
         );
      end if;
   end Create;

end Py.Module;

The implementation of Create adds the module. It must be called before Initialize. After that it can be used in Python as follows:

import sample_module
def Code():
   s = sample_module.operation(1,b='?')
   print(s)

[Back][TOC][Next]

17. Networking

[Back][TOC][Next]

17.1. Multiple TCP connections servers

A typical server implementation usually listens a socket for incoming connections. When a connection is accepted, a separate task is started to handle the connection. The task reads the socket in a blocking manner. This is a very simple, easy to implement and relatively efficient design when connections are few. The problems arise with large number of connections. The number of tasks the OS can handle is limited. Furthermore, with a large number of tasks, switching them would consume considerable resources. An alternative would be a single task handling a set of sockets, one socket per connection. The available number of sockets is usually much greater than the number of tasks. However, the design of a server working in this way is sufficiently more difficult because differently to blocking I/O, the server becomes driven by data. A connection would process as much data as available, remember its state and wait until more data become available. In essence the server must implement some light-weight version of multitasking. The described below set of packages is provided to ease design of such servers targeting heavy duty or small embedded solutions.

There are three major types of objects used:

17.1.1. Multiple connections servers

The package GNAT.Sockets.Server provides basic tools for implementation of multiple connection servers and clients. The implementation is based on GNAT sockets.

Connections server.

type Connections_Server
     (  Factory : access Connections_Factory'Class;
        Port    : Port_Type
     )  is new Ada.Finalization.Limited_Controlled with private;
type Connections_Server_Ptr is access all Connections_Server'Class;
 

The type Connections_Server is the type a connections server. The discriminants are:

The server starts one task which does all socket I/O and services connected client requests. See also GNAT.Sockets.Server.Pooled package which provides a server backed by a pool of worker tasks. Note also that a server may run any TCP/IP-based protocols. It is up to the connection object it implement the protocol. The server can handle both incoming and outgoing connections. The only the latter is intended Port can be specified as 0.

The following primitive operations are defined on Connections_Server:

procedure Connect
          (  Listener       : in out Connections_Server;
             Client         : Connection_Ptr;
             Host           : String;
             Port           : Port_Type;
             Max_Connect_No : Positive := Positive'Last;
             Overlapped     : Stream_Element_Count :=
                              Stream_Element_Count'Last
          );

This procedure is called to make Listener connecting to a remove host and thus acting as a client. Client is a newly created connection object which will handle the connection when it becomes established. The server manages the object (see also memory management of connection objects). In particular the object will be finalized and deallocated by the server. Host is the name or IP address of the remote host. Port is the port to connect to. Max_Connect_No is the maximum number of consecutive attempts to connect. Overlapped is the amount of overlapped read to use (see Set_Overlapped_Size). The default value enables full-duplex exchange which is customary for clients. The procedure only initiates connecting, which is dealt asynchronously. Once connection is established Connected is called, as usual. When connection is lost Disconnected is called. Note that differently to incoming connections, for an outgoing connection like this, the server attempts (Max_Connect_No times) to reconnect to the host if the connection is lost. In order to prevent this behavior Disconnected may propagate Connection_Error exception. One can use Shutdown as well. Host_Error is propagated on errors resolving remove host name. Socket_Error is propagated on socket errors.

procedure Connected
          (  Listener : in out Connections_Server;
             Client   : in out Connection'Class
          );

This procedure is called to notify the server Listener that the client is being connected. It is called after Client's Connected. The default implementation must be called from the override. The implementation may propagate Connection_Error to refuse connection.

procedure Create_Socket
          (  Listener : in out Connections_Server;
             Socket   : in out Socket_Type;
             Address  : Sock_Addr_Type
          );

This procedure is called to create the socket the server will listen to. The default implementation creates the socket Socket, sets socket reuse option to true, binds the socket to Address, listens to the socket. On unrecoverable errors an exception is propagated. Here is the code snippet of the default implementation:

procedure Create_Socket
          (  Listener : in out Connections_Server;
             Socket   : in out Socket_Type;
             Address  : Sock_Addr_Type
          )  is
begin

   Create_Socket (Socket);
   Set_Socket_Option (Socket, Socket_Level, (Reuse_Address, True));
   Bind_Socket (Socket, Address);
   Listen_Socket (Socket);
end Create_Socket;

When Socket remains No_Socket the server's worker task exits. Note that if the implementation calls the default implementation and catches exceptions then if the exception is not propagated the socket must be closed before setting it to No_Socket.

procedure Disconnected
          (  Listener : in out Connections_Server;
             Client   : in out Connection'Class
          );

This procedure is called to notify the server Listener that the client is being disconnected. It is called before Client's Disconnected operation is called. The implementation removes the client from the list of clients postponed for service. If overridden the new implementation should call the parent's one. The implementation may propagate Connection_Error to prevent further connection attempts for outgoing connections.

procedure Downed
          (  Listener : in out Connections_Server;
             Client   : in out Connection'Class
          );

This procedure is called to notify the server Listener that the client has been shot down. It is called before Client's Downed operation is called. The reference to the object is released after the call. The default implementation must be called from the override.

procedure Finalize (Listener : in out Connections_Server);

This procedure is called upon object destruction. It closes all active connections and frees all other resources. When the derived type overrides this procedure it shall call it from its implementation.

function Get_Clients_Count (Listener : Connections_Server)
   return Natural;

This function returns the number of clients currently connected to the server Listener.

function Get_Server_Address (Listener : Connections_Server)
   return Sock_Addr_Type;

This function is called before the server starts listening its socket. The result is the address to listen. The default implementation returns an address of the AF INET family with any address the host has and the port taken from the Listener's discriminant Port. It can be overridden in order to limit the addresses listened.

procedure Initialize (Listener : in out Connections_Server);

This procedure is called upon object construction. It closes all active connections and frees all other resources. When the derived type overrides this procedure it shall call it from its implementation.

function Is_Unblock_Send_Queued (Listener : Connections_Server)
   return Boolean;

This function returns true if a request to unblock send is queued (see Unblock_Send).

procedure On_Worker_Start (Listener : in out Connections_Server);

This procedure is called when the worker task starts. The default implementation does nothing.

procedure Receive_Socket
          (  Listener : in out Connections_Server;
             Client   : in out Connection'Class;
             Data     : in out Stream_Element_Array;
             Last     : out Stream_Element_Offset
          );

This procedure is used to receive an available portion of data. Listener is the connection server, Client is the client for which data are received. Data is the buffer to store the data. Last is the index of the last stored stream element after completion. In the case of sockets Receive_Socket is only called when the underlying socket can be read without blocking. Returned Last < Buffer'First indicates connection loss. Receive_Socket may not block. The default implementation reads from the socket.

procedure Request_Disconnect
          (  Listener  : in out Connections_Server;
             Client    : in out Connection'Class;
             Reconnect : Boolean
          );

This procedure implements object connection's operations Shutdown and Reconnect. The default implementation of these call this procedure. The parameter Reconnect if false causes shutdown.

procedure Send_Socket
          (  Listener : in out Connections_Server;
             Client   : in out Connection'Class;
             Data     : Stream_Element_Array;
             Last     : out Stream_Element_Offset
          );

This procedure is used to send a portion of data. Listener is the connection server, Client is the client for which data are received. Data is the buffer with the data. Last is the index of the last stream element sent away. In the case of sockets Send_Socket is only called when the underlying socket can be written without blocking. Send_Socket may not block. The default implementation writes into the socket.

procedure Unblock_Send
          (  Listener : in out Connections_Server;
             Client
   : in out Connection'Class
          );

This procedure explicitly unblocks socket polling for send. Normally it happens automatically when Send is called or when the timeout expires (see Get_Polling_Timeout).

Connection objects factory.

type Connections_Factory is abstract
   new
Ada.Finalization.Limited_Controlled with private;

The type Connections_Factory is the type of a factory object that the server uses to create connection objects. The following primitive operations defined on the factory:

function Create
         (  Factory  : access Connections_Factory;
            Listener : access Connections_Server;
            From     : Sock_Addr_Type
         )  return Connection_Ptr;

This function is called when the server is about to accept an incoming connection from a client. The implementation may refuse connection in which case it returns null. When connection is accepted the implementation allocates a new connection object and returns a pointer to it. After this it is the server's responsibility to free the object. Thus there is no need to care about the objects returned from Create, they will be freed automatically (see also memory management of connection objects). The implementation may deploy client filtering based on the address From and/or the number of active connections. The default implementation returns null.

function Get_Client_Name
         (  Factory : Connections_Factory;
            Client  : Connection'Class
         )  return String;

This function return the client's name. This name is used in tracing to identify the client. The default implementation uses IP address returned by the function Get_Client_Address for the client name.

function Get_IO_Timeout (Factory : Connections_Factory)
   return Duration;

When the connections server waits for a socket to become readable or writable this value specifies the waiting timeout. Upon the timeout expiration the server re-enters the waiting. Some actions may require timeout expiration if there is no active socket I/O. For example enabling polling of the sockets for being writable is such an action. The default value of 20 ms is returned by this function, which can be overridden in order to change it.

function Get_Polling_Timeout (Factory : Connections_Factory)
   return Duration;

The connections server stops polling a socket for being writable for no longer than the value returned by this function. The server stops polling the socket for being writable when there is nothing to send in order to reduce overhead. The polling is automatically resumed when some data are sent. This is normally happens in response to some data sent from by the client. In some cases socket must be unblocked regardless the client. The value returned by this function specifies the duration after which all sockets are unblocked. If there is still nothing to send they will be blocked again. The default implementation returns 0.5 s. Note that in absence of socket I/O, unblocking cannot happen earlier than I/O timeout expiration as defined by Get_IO_Timeout. This function can be overridden in order to change the value.

function Is_TLS_Capable
         (  Factory : Connections_Factory;
         )  return Boolean;

This function returns true if the factory can create TLS transport (see Create_Transport). When an opportunistic TLS is used a connection object can use this function in order to determine if the provided factory is capable of TLS before proposing or accepting switching to TLS. The default implementation returns false.

function Is_Trace_Received_On
         (  Factory : Connections_Factory;
            Encoded : IO_Tracing_Mode
         )  return Boolean;

This function returns true if tracing of received encoded/ciphered or plain data is enabled. See Trace_On. The parameter Encoded specifies the content type to query tracing. It has the type IO_Tracing_Mode:

type IO_Tracing_Mode is
     (  Trace_None,
        Trace_Encoded,
        Trace_Any,
        Trace_Decoded
     );

The meaning of the values is as follows:

function Is_Trace_Sent_On
         (  Factory : Connections_Factory;
            Encoded : IO_Tracing_Mode
         )  return Boolean;

This function returns true if tracing of sent data is enabled. The parameter Encoded specifies the content type to query tracing. It has the type IO_Tracing_Mode. See Trace_On.

procedure Received
          (  Factory : in out Connections_Factory;
             Client  : in out Connection'Class;
             Data    : Stream_Element_Array;
             From    : Stream_Element_Offset;
             To      : Stream_Element_Offset
          );

This procedure is called when a portion of data is read from the socket of the connection object Client. Data is the receive buffer. The data read is Data (From..To). The default implementation traces the input. If overridden the parent implementation should likely be called from the new implementation to keep tracing working.

procedure Trace
          (  Factory : in out Connections_Factory;
             Message : String
          );

This procedure is used for tracing.

procedure Trace_Error
          (  Factory    : in out Connections_Factory;
             Context    : String;
             Occurrence : Exception_Occurrence
          );

This procedure is called when an unanticipated exception is caught. Context is a string describing the context where the exception occurred. Occurrence is the exception occurrence. The default implementation uses Trace to report exception information.

procedure Trace_On
          (  Factory          : in out Connections_Factory;
             Received         : Boolean := False;
             Sent             : Boolean := False;
             Encoded_Received : Boolean := False;
             Encoded_Sent     : Boolean := False
          );

This procedure enables tracing into the standard output. The parameters Received and Sent specify whether plain incoming and outgoing data should be traced as well. Encoded_Received and Encoded_Sent do whether encoded/ciphered incoming and outgoing data should be traced as well.

procedure Trace_On
          (  Factory          : in out Connections_Factory;
             Name             : String;
             Received         : Boolean := False;
             Sent             : Boolean := False;
             Encoded_Received : Boolean := False;
             Encoded_Sent     : Boolean := False
          );

This procedure enables tracing into the specified file. When there is already trace file open, it is closed first. This procedure propagates exceptions upon errors on file closing and opening. The parameters Received and Sent specify whether the incoming and outgoing data should be traced as well. Encoded_Received and Encoded_Sent do whether encoded/ciphered incoming and outgoing data should be traced as well.

procedure Trace_Off (Factory : in out Connections_Factory);

This procedure disables all tracing.

procedure Trace_Received
          (  Factory : in out Connections_Factory;
             Client  : Connection'Class;
             Data    : Stream_Element_Array;
             From    : Stream_Element_Offset;
             To      : Stream_Element_Offset;
             Encoded : Boolean := False
          );

This procedure is called to trace data received for a client. The data received are Data (From..To). Tracing is enabled or disabled by the Received parameter of Trace_On. Encoded is true when Data contains encoded or ciphered data. The default implementation uses Trace to report received data.

procedure Trace_Sending
          (  Factory : in out Connections_Factory;
             Client  : Connection'Class;
             Enabled : Boolean;
             Reason  : String
          );

This procedure is called to trace enabling and disabling polling the client's socket. The parameter Enabled is true when polling is enabled and false when disabled. Reason is the text describing the reason of enabling or disabling polling. When there output buffer becomes empty, polling the socket for being writable is stopped in order to reduce system load. When output buffer becomes written, polling is started again. Tracing is enabled or disabled by the Sent parameter of Trace_On. The default implementation uses Trace to report sent data.

procedure Trace_Sent
          (  Factory : in out Connections_Factory;
             Client  : Connection'Class;
             Data    : Stream_Element_Array;
             From    : Stream_Element_Offset;
             To      : Stream_Element_Offset;
             Encoded : Boolean := False
          );

This procedure is called to trace data sent to a client. The data sent are Data (From..To). Tracing is enabled or disabled by the Sent parameter of Trace_On. Encoded is true when Data contains encoded or ciphered data.. The default implementation uses Trace to report sent data.

procedure Trace_Service_Loop
          (  Factory : in out Connections_Factory;
             Stage   : Service_Loop_Stage;
             Server  : in out Connections_Server'Class
          );

This procedure is called at different stages of the service loop. The default implementation does nothing. The parameter Stage identifies the loop stage:

type Service_Loop_Stage is
     (  Service_Loop_Begin,      -- Begin of the service loop
        Service_Loop_Reading,    -- Reading from ready sockets
        Service_Loop_Unblocking, -- Unblocking sockets with data
        Service_Loop_Writing,    -- Writing to ready sockets
        Service_Loop_Postponed   -- Servicing postponed requests
     );

The parameter Server identifies the connections server.

Connection_Error : exception;

The exception indicating connection errors.

subtype Buffer_Length is
   Stream_Element_Offset range 1..Stream_Element_Offset'Last;

The positive buffer length.

function Image (Code : Error_Type) return String;

This function returns text corresponding to a socket error code.

function To_Addr (Host : String) return Inet_Addr_Type;

This function returns the IP address corresponding to Host. Host can be name or a dotted address. Socket_Error is propagated on errors.

Transport layer

type Encoder (Size : Buffer_Length) is abstract
   new
Ada.Finalization.Limited_Controlled with private;
type Encoder_Ptr is access all Encoder'Class;

The type Encoder is the type of a transport layer object that the server uses to handle encoded or ciphered connections. Protocols like SSL/TSL decode incoming TCP/IP stream and encode the outgoing one. The package GNAT.Sockets.Server.Secure provides an implementation of a SSL/TSL encoder. The following primitive Encoder operations are abstract:

procedure Encode
          (  Transport : in out Encoder;
             Client    : in out Connection'Class;
             Data      : Stream_Element_Array;
             Last      : out Stream_Element_Offset
          )  is abstract;

This procedure is called to encode/cipher outgoing data. The implementation encodes a portion of Data and send it to the client. Last is set to the last encoded element.

procedure Process
          (  Transport : in out Encoder;
             Listener  : in out Connections_Server'Class;
             Client    : in out Connection'Class;
             Data_Left : out Boolean
          )  is abstract;

This procedure is called to handle a portion of incoming encoded data. The output parameter Data_Left is false when all data are processed. The implementation of the procedure must ultimately call to the client's Received to feed the client with decoded data.

The primitive connection factory function is called to create transport layer:

function Create_Transport
         (  Factory  : access Connections_Factory;
            Listener : access Connections_Server'Class;
            Client   : access Connection'Class
         )  return Encoder_Ptr;

This function creates an instance of Encoder used to handle encoding/ciphered transport. The result is null, which is the default implementation to indicate than the transport is not coded. The returned object is handled by the server, which finalizes and deallocates it when no more used. When transport acts differently for a server from a client, which is the case for SSL handshake the type of connection can be determined using Is_Incoming.

17.1.2. Connection objects

The package GNAT.Sockets.Server declares the abstract base type for objects corresponding a connection:

type Connection
     (  Input_Size  : Buffer_Length;
        Output_Size : Buffer_Length
     )  is abstract new Object.Entity with private;
type Connection_Ptr is access all Connection'Class;

For incoming connections objects of a type derived from Connection are created and returned by the factory operation Create. For outgoing connections the object are created by the caller of Connect. The discriminants are:

Connection objects are reference-counted. When Create or Connect passes an object to the server this increases its reference count. When the server drops the object the reference count is decreased. Once the count reaches zero the object is finalized and deallocated. When a newly created object simply returned from Create or passed to Connect there is nothing to worry about. The object will be collected when no more in use. If the object's creator wants to keep the object it should create a handle to it (see Object.Handle) and store the handle somewhere. This will increase the reference count and will hold the object so long the handle object exist.

Note that objects used to connect to a remote host, i.e. ones used in Connect continue to exist when the caller of Connect holds no handle to it because one last handle is still maintained by the connections server. Therefore if the caller wants to destroy the object it must call Shutdown before it drops its handle. Shutdown will drop the connection and since the connection server will not attempt to reconnect after Shutdown was called it will drop its handle as well, and that will destroy the object.

The handles to connection objects can be created this way:

package Connection_Handles is
   new
Object.Handle (Connection, Connection_Ptr);

The following primitive operations are defined on the Connection type:

procedure Activated (Client : in out Connection);

This procedure is called when the session becomes ready to communication. At this point the server or client can initiate exchange with the pier. The default implementation does nothing. The intended case is for implementation of asynchronous autonomous clients. A client is created using new-allocator and passed to the connection server's Connect. The connection process is handled asynchronously. Upon successful connection Activated is called. From there the client initiates exchange by sending a request to the pier. For example a HTTP client could send a GET request. The response is then handled by the client from a corresponding protocol callback. At the end of session the client calls Shutdown which terminates the session and the client gets collected.

function Available_To_Process (Client : Connection)
   return Stream_Element_Count;

This function returns the number of received but not yet processed stream elements.

function Available_To_Send (Client : Connection)
   return Stream_Element_Count;

This function returns is the maximum number of stream elements which Send is guaranteed to accept. Larger number may cause Send returning the parameter Pointer less or equal to Data'Last.

procedure Clear (Client : in out Connection);

This procedure clear the internal state of Client. Normally, the client is created upon connection and requires no cleanup.

procedure Connect_Error
          (  Client : in out Connection;
             Error  : Error_Type
          );

This procedure is called when the server fails to connect to the remote host. It may propagate Connection_Error in order to prevent further attempts to connect. The default implementation does nothing.

procedure Connect_Parameters_Set
          (  Client         : in out Connection;
             Host           : String;
             Address        : Sock_Addr_Type;
             Max_Connect_No : Positive
          );

This procedure is called when connection parameters are set for an outgoing connection. The default implementation does nothing. If overridden, the new implementation should probably call the parent's  implementation.

procedure Connected (Client : in out Connection);

This is the first operation called on Client when connected to a remote host. If overridden, the parent's implementation must be called from the override. Typically the server may set some socket options here. The implementation may propagate Connection_Error if it decides to refuse connection this late. Note that at the call point the client or server is not yet ready to communicate, see Activated for the purpose.

procedure Create_Transport (Client : in out Connection);

The connections with Is_Opportunistic returning true do not start secure exchange. It is explicitly started by calling this procedure. Status_Error is propagated when the connection already has a transport layer. Use_Error is propagated when transport is not created (Create_Transport returned false).

procedure Disconnected (Client : in out Connection);

This is procedure is called when connection is dropped. If overridden, the parent's implementation must be called from the override. The implementation may propagate Connection_Error to prevent reconnection if the object services an outgoing connection.

procedure Downed (Client : in out Connection);

This is procedure is called when connection has been shot down. After this call server's Downed is called and finally the reference to the connection object is released after. The default implementation does nothing.

procedure Elevated (Client : in out Connection);

This procedure is called when an opportunistic transport layer is created and ready to use. When a connection with Is_Opportunistic returning true calls Create_Transport this creates a transport layer, usually encrypted, to continue exchange over the layer. After a successful handshake, when the exchange can be continued this procedure is called. The default implementation does nothing. Note that when Is_Opportunistic returning false the transport is created right after establishing a connection and handshake completion is notified by calling Connected. In contrast to this when Is_Opportunistic returns true, Connected is called first, then the client class Create_Transport and after that receives Elevated.

procedure Finalize (Client : in out Connection);

This procedure is called upon object destruction. It closes all active connections and frees all other resources. When the derived type overrides this procedure it shall call it from its implementation.

function Get_Client_Address (Client : Connection) return Sock_Addr_Type;

This function returns the client's address.

function Get_Connections_Server (Client : Connection)
   return Connections_Server_Ptr;

This function returns the connections server handling the Client or null.

procedure Get_Occurrence
          (  Client     : Connection;
             Occurrence : out Exception_Occurrence
          );

This procedure gets the error occurrence saved using Save_Occurence.

function Get_Overlapped_Size (Client : Connection)
   return Stream_Element_Count;

This function returns the maximum number of elements queued to send before receiving is blocked. See Set_Overlapped_Size for detailed description.

function Get_Socket (Client : Connection) return Socket_Type;

This function returns the socket used by the connection. The socket shall not be read or written explicitly.

function Get_Session_State (Client : Connection) return Session_State;

This function returns session state of the connection. It may have one of Session_State values.

type Session_State is
     (  Session_Down,
        Session_Disconnected,
        Session_Connecting,
        Session_Handshaking,
        Session_Connected,
        Session_Busy
     );

The values are:

function Is_Connected (Client : Connection) return Boolean;

This function returns true if Client is connected. This corresponds to the states Session_Connected and Session_Busy.

function Is_Down (Client : Connection) return Boolean;

This function returns true if Client can be reused. Normally objects are collected when no more service a connection (see memory management of connection objects). An object for which this function returns true, the object can be again returned from Create or passed to Connect. Note that doing so, you should clean up the object's extension fields if any. Usually Connected is an appropriate place to do this.

function Is_Elevated (Client : Connection) return Boolean;

This function returns true if the connection uses a transport layer, e.g. TLS.

function Is_Incoming (Client : Connection) return Boolean;

This function returns true if Client handles an incoming connection and acts as a server. It returns false if Client handles an outgoing connection (a client).

function Is_Opportunistic (Client : Connection) return Boolean;

This function returns true if the connection deploys opportunistic security encoding. The default is false, that means the connection engages security transport immediately once established. When the result is true the exchange starts not secured and turns into secure mode only when both parties agree on that. An example of opportunistic secure connection is SMTP with its STARTTLS command.

procedure Keep_On_Sending (Client : in out Connection);

This procedure is called to hint the connections server that it should not stop polling the socket for being writable, because some content to send is about to come. See also Get_Polling_Timeout, which provides a less resource consuming alternative of resuming sending.

procedure Process
          (  Client    : in out Connection;
             Data_Left : out Boolean
          );

This procedure is used internally to handle a portion of incoming data. Data_Left is returned true if not all data were processed. It should not be called explicitly. Note that the implementation is aware of the transport layer and thus should not be called from an implementation of Encoder.

procedure Process_Packet (Client : in out Connection);

This procedure is called when all fields of Client, e.g. ones with the types derived from Data_Item have been received from the client. The default implementation does nothing. Exceptions propagating from the procedure cause the server to close the connection.

procedure Pull
          (  Client  : in out Connection;
             Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset
          );

This procedure can be used to extract input data skipping standard processing them. E.g. it can be called from an overridden implementation of Process. Pointer is advanced to the first unused element in Data.

function Queued_To_Send (Client : Connection)
   return Stream_Element_Count;

This function returns the number of stream elements pending to be sent in the output buffer.

procedure Received
          (  Client  : in out Connection;
             Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset
          );

This procedure is called when a portion of data is read from the socket. The parameter Pointer is initially set to Data'Last + 1. The implementation of Received must modify it if it does not process all data. In that case it moves Pointer backwards to indicate the first unprocessed element. The data in Data (Pointer..Data'Last) will stay in the buffer until a next call to Received. Connection_Error is propagated to close the connection. Other exceptions also cause the server to close the connection, but also call to Trace_Error. The default implementation raises Connection_Error.

procedure Receive_Error
          (  Client     : in out Connection;
             Occurrence : Exception_Occurrence
          );

This procedure is called upon a socket receive error before the connection is dropped. The default implementation does nothing.

procedure Reconnect (Client : in out Connection);

This procedure drops the current connection and attempts to reconnect.

Exceptions
Mode_Error The connection is a server connection and cannot be reconnected
Status_Error The connection is down, e.g. Shutdown was called
Use_Error The connection was never engaged before, i.e. no Connect was ever called

procedure Released (Client : in out Connection);

This procedure is called when Client is no more in use. The default implementation does nothing.

procedure Save_Occurrence
          (  Client     : in out Connection;
             Occurrence : Exception_Occurrence
          );

This procedure saves error occurrence, which can be queried later using Get_Occurence.

procedure Send
          (  Client  : in out Connection;
             Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset
          );
procedure
Send
          (  Client  : in out Connection;
             Data    : String;
             Pointer : in out Integer
          );

These procedures are used to send data to the client. The parameter Pointer specifies the first data item to send. When completed Pointer is advanced to the first unsent item. The procedures do not block. They queue as much data as possible for sending. The number of elements available for queuing is returned by Available_To_Send. The elements which cannot be queued are Data (Pointer..Data'Last). When this happens they should be kept by the caller until Send is called again. Socket_Error is propagated on send errors. Layout_Error is propagated when Pointer is not in Data'First..Data'Last + 1.

procedure Send
          (  Client : in out Connection;
             Stream : in out Root_Stream_Type'Class;
             End_Of_Stream : out Boolean
          );

This procedure is used to send data from the stream specified by the parameter Stream. The procedure does not block, it reads as much data from Stream as possible to queue without waiting and return End_Of_Stream set to false. End_Of_Stream set to true when all Stream is read and queued. The output buffer is used for reading out Stream. Thus the amount of data read depends on how much free space is the buffer.

procedure Send
          (  Client        : in out Connection;
             Stream        : in out Root_Stream_Type'Class;
             Reserve       : Stream_Element_Count;
             Get_Prefix    : Create_Stream_Element_Array;
             Get_Suffix    : Create_Stream_Element_Array;
             End_Of_Stream : out Boolean
          );
procedure
Send
          (  Client        : in out Connection;
             Stream        : in out Root_Stream_Type'Class;
             Reserve       : Natural;
             Get_Prefix    : Create_String_Prefix;
             End_Of_Stream : out Boolean
          );

These procedures are used to send data read from a stream with each chunk of stream data prefixed and suffixed. The contents of the prefix and suffix may depend on the data in the chunk. For instance the prefix may contain the encoded length of the data chunk, the suffix may contain a checksum. The parameter Reserve specifies the maximum summary length of prefix and suffix. This amount of space is reserved in the output buffer prior to reading Stream into it. The parameter Get_Prefix is the function called to get the prefix once the chunk is read from Stream. The parameter Get_Suffix is the function called to get the suffix. These functions have the following type:

type Create_Stream_Element_Array is access function
     (  Client : access Connection'Class;
        Data   : Stream_Element_Array;
        End_Of_Stream : Boolean
     )  return Stream_Element_Array;
type
Create_String is access function
     (  Client : access Connection'Class;
        Data   : Stream_Element_Array;
        End_Of_Stream : Boolean
     )  return String;

The parameter Data is the data chunk to be prefixed or suffixed by the result. The parameter End_Of_Stream is true when this was the last chunk. Otherwise, End_Of_Stream is set to false.

procedure Send_Error
          (  Client     : in out Connection;
             Occurrence : Exception_Occurrence
          );

This procedure is called upon a socket send error before the connection is dropped. The default implementation does nothing.

procedure Sent (Client : in out Connection);

This procedure is called when some portion of data was successfully sent leaving free space in the output buffer. The implementation may try to send data pending after the last call to Send, e.g. the contents of Data (Pointer..Data'Last). That is when the connection deploys a secondary buffering. The default implementation does nothing.

procedure Set_Expected_Count
          (  Client : in out Connection;
             Count  : Stream_Element_Count
          );

This procedure sets the number of elements to accumulate before calling Received. When Count is 0 any number of read elements causes a call to Received. When Count is larger than the input buffer size, Received is called for each full buffer. Note that Set_Expected_Count has effect only once. When all elements are read the count is reset to 0 and Set_Expected_Count must be called again.

procedure Set_Overlapped_Size
          (  Client : in out Connection;
             Size   : Stream_Element_Count
          );

This procedure sets the read socket policy when there are data pending to send. The parameter Size specifies the maximum amount of data queued for send without blocking receiving. The default value is 0 meaning strictly half-duplex behavior. That is, nothing is read before the client accepts all data. Typically for a packet-oriented protocol, the server reads a packet completely and then sends a response packet or a set of packets back. Doing that it stops reading new packets. To implement such policy Set_Overlapped_Size is set to 0 and the output buffer size is set to the maximum packet length. This would guarantee that Send called from Received would always be able to queue a complete packet.

procedure Shutdown (Client : in out Connection);

The connection object is removed when the client closes the connection. This procedure can be used to explicitly drop the connection. It can be used from any task. The object shall not be used afterwards because the server may finalize and deallocate it at any time. Mode_Error is propagated when the connection is permanent.

procedure Unblock_Send (Client : in out Connection);

This procedure explicitly unblocks socket polling for send. Normally it happens automatically when Send is called or when the timeout expires (see Get_Polling_Timeout). The implementation calls to the connection server's Unblock_Send.

17.1.3. Secure GNUTLS servers

The package GNAT.Sockets.Server.Secure provides an implementation of the connection server with a secure SSL/TLS layer, e.g. HTTPS, based on GNUTLS. The architecture of secure SSL/TLS communication is that the encryption layer sits on top of the TCP/IP stream. The original protocol (e.g. HTTP) exchange is not altered. The server's outgoing traffic goes to the SSL/TLS layer and gets encrypted before sending it over the socket. Correspondingly, the incoming traffic is first decrypted and then routed to the original protocol. The server supports both incoming and outgoing encrypted connections. Right after a connection is established a handshake is performed by the SSL/TLS layer. When the handshake is successful the exchange is started to proceed as described above.

The implementation of SSL/TLS layer in this package is based on the GNUTLS library. The following abstract data type implements an abstract SSL/TLS connections factory:

type Abstract_GNUTLS_Factory
     (  Decoded_Size : Buffer_Length
     )  is abstract new Connections_Factory with private;

Custom factories must be derived from this base type. When a connection to the client is first established, the server using a factory derived from this type engages a handshaking which includes exchange of certificates. When the handshaking is successful the following exchange continues encrypted. There is no need to change anything in the original protocol implementation. Both secure and insecure factories may use same client connection objects.

Note that TLS encoding introduces per-record encoding overhead. Thus smaller portions of sent data have relatively higher overhead. In order to prevent excessive fragmentation the output buffer (discriminant Output_Size of Connection object) should be reasonable large.

The following primitive operations are defined on Abstract_GNUTLS_Factory:

procedure Handshake_Completed
          (  Factory : in out Abstract_GNUTLS_Factory;
             Client  : in out Connection'Class;
             Session : in out Session_Type
          );

This procedure is called upon TLS handshake completion. The implementation may use it in order to check the session, e.g. verifying client's certificates. The default implementation does nothing. When Connection_Error is propagated the connection is silently dropped. Other exceptions drop connection as well.

function Is_Trace_Decoded
         (  Factory : Abstract_GNUTLS_Factory
         )  return Boolean;

This function returns true if tracing of original protocol output is enabled. See Set_TLS_Tracing.

function Is_Trace_Session
         (  Factory : Abstract_GNUTLS_Factory
         )  return Boolean;

This function returns true if tracing of TLS session state changes is enabled. See Set_TLS_Tracing.

procedure Prepare
          (  Factory : in out Abstract_GNUTLS_Factory;
             Client  : in out Connection'Class;
             Session : in out Session_Type
          )  is abstract;

This abstract primitive operation is called when a connection is established. Client is the client connection object. Note that Prepare is called prior to Connected. The objective of Prepare is to set up the TLS session specified by the Session parameter. This normally includes setting certificates and keys into Session.

procedure Set_TLS_Tracing
          (  Factory : in out Abstract_GNUTLS_Factory;
             Session : Boolean;
             Decoded : Boolean
          );

This procedure enables or disables tracing of the decoded output and/or TLS session state changes.

X.509 authentication factory

The package GNAT.Sockets.Server.Secure.X509 provides an implementation of connection factory for X.509 and OpenPGP certificates.

type X509_Authentication_Factory is abstract
   new
Connections_Factory with private;

Custom factories must be derived from this base type. When a connection to the client is first established, the server using a factory derived from this type engages a handshaking which includes exchange of certificates. When the handshaking is successful the following exchange continues encrypted. There is no need to change anything in the original protocol implementation. Both secure and insecure factories may use same client connection objects. The following primitive operations are defined subdivided into sections:

Certificate revocation list species revoked certificates, which thus should no longer be trusted.

procedure Add_CRL
          (  Factory : in out X509_Authentication_Factory;
             List    : X509_CRL_Array
          );

This procedure adds the trusted CRLs in order to verify client certificates. List is the array containing CRL to add.

procedure Add_CRL_DER
          (  Factory     : in out X509_Authentication_Factory;
             Certificate : Stream_Element_Array
          );

This procedures adds a trusted CRL in order to verify client certificates.

procedure Add_CRL_From_{DER|PEM}_File
          (  Factory : in out X509_Authentication_Factory;
             File    : String
          );

These procedures add the trusted CRLs in order to verify client certificates from a file with the name File. The procedure name corresponds to the file format, DER for binary file format, PEM for text file format.

procedure Add_CRL_PEM
          (  Factory     : in out X509_Authentication_Factory;
             Certificate : String
          );

This procedures adds a trusted CRL in order to verify client certificates.

Public and private keys are pairs used for encryption, decryption, and signing.

procedure Add_Key
          (  Factory     : in out X509_Authentication_Factory;
             Public_Key  : OpenPGP_Crt;
             Private_Key : OpenPGP_Privkey
          );

This procedure adds a certificate/private OpenPGP key pair. Public_Key is the public key, Private_Key is the private key. More than one keys pair can be added.

procedure Add_Key_DER
          (  Factory     : in out X509_Authentication_Factory;
             Certificate : Stream_Element_Array;
           [ Key         : Stream_Element_Array; ]
           [ Encryption  : PKCS_Encrypt_Flags;
             Password    : String ]
          );

These procedures set a certificate/private key pair into factory. They may be called more than once. The key may be omitted if only certificate need to be added.

procedure Add_Key_PEM
          (  Factory     : in out X509_Authentication_Factory;
             Certificate : String;
           [ Key         : String; ]
           [ Encryption  : PKCS_Encrypt_Flags;
             Password    : String ]
          );

These procedures set a certificate/private key pair into factory. They may be called more than once. The key may be omitted if only certificate need to be added.

procedure Add_Key_From_{DER|PEM}_File
          (  Factory          : in out X509_Authentication_Factory;
             Certificate_File : String;
             Key_File         : String;
           [ Encryption       : PKCS_Encrypt_Flags;
             Password         : String ]
          );

These procedures set a certificate/private key pair into factory. These procedures may be called more than once. These procedures can also accept URLs at Certificate_File and Key_File. In that case it will import the private key and certificate indicated by the URLs. The supported URLs are the ones indicated by URL_Is_Supported. In case the Certificate_File is provided as a PKCS 11 URL, then the certificate, and its present issuers in the token are are imported (i.e. the required trust chain). The procedure name corresponds to the file format, DER for binary file format, PEM for text file format.

procedure Add_Key_From_{Base64|Raw}_File
          (  Factory      : in out X509_Authentication_Factory;
             Public_Key   : String;
             Private_Key  : String;
           [ Subkey_ID  ] : String
          );

These procedures add OpenPGP keys into the factory. Public_Key is the file name containing the public key, Private_Key is one of the private key. The files should contain at least one valid non-encrypted subkey. The procedure name corresponds to the file format, raw or else Base64.

procedure Add_Key_From_{Base64|Raw}_File
          (  Factory      : in out X509_Authentication_Factory;
             Public_Key   : String;
             Private_Key  : String;
           [ Subkey_ID  ] : String
          );

These procedures add OpenPGP keys into the factory. Public_Key is the file name containing the public key, Private_Key is one of the private key. The files should contain at least one valid non-encrypted subkey. These procedures may be called more than once. The procedure name corresponds to the file encoding, raw or else Base64.

procedure Add_Key_From_{Base64|Raw}_Ring
          (  Factory : in out X509_Authentication_Factory;
             File    : String
          );

These procedures add OpenPGP keys the into the factory. The keys are taken from the keyring file File. The files should contain at least one valid non-encrypted subkey. These procedures may be called more than once. The procedure name corresponds to the keyring file format, raw or else Base64.

Trusted certificates list contains certificates issued by trusted certificate authority. All certificates should be tracked down to a trusted source.

procedure Add_Trust
          (  Factory : in out X509_Authentication_Factory;
             List    : X509_Crt_Array
          );

This procedure adds the trusted CAs in order to verify client certificates. This procedure may be called more than once.

procedure Add_Trust_DER
          (  Factory     : in out X509_Authentication_Factory;
             Certificate : Stream_Element_Array
          );

These procedures add the trusted CA in order to verify client certificates. They may be called multiple times.

procedure Add_Trust_From_{DER|PEM}_File
          (  Factory : in out X509_Authentication_Factory;
             File    : String
          );

These procedures add the trusted CAs in order to verify client certificates. They may be called multiple times. They can also accept URLs. In that case it will import all certificates that are marked as trusted. The procedure name corresponds to the file format, DER for binary file format, PEM for text file format.

procedure Add_Trust_PEM
          (  Factory     : in out X509_Authentication_Factory;
             Certificate : String
          );

These procedures add the trusted CA in order to verify client certificates. They may be called multiple times.

procedure Add_System_Trust
          (  Factory : in out X509_Authentication_Factory
          );

This procedure adds the system's default trusted CAs in order to verify client certificates.

Diffie-Hellman parameters of securely exchanged cryptographic keys over a public channel.

procedure Generate_Diffie_Hellman_Parameters
          (  Factory : in out X509_Authentication_Factory
          );

This procedure generates Diffie-Hellman parameters. The operation is time-consuming. If not generated explicitly, parameters are generated on demand.

Online Certificate Status Protocol (OCSP) is an Internet protocol used for obtaining the revocation status of an X.509 digital certificate.

procedure Set_OCSP_Response_File
          (  Factory : in out X509_Authentication_Factory;
             File    : String
          );

This procedure sets the filename of an OCSP response, that will be sent to the client if requests an OCSP certificate status.

General priorities, parameters used for authentication.

procedure Set_Priorities
          (  Factory    : in out X509_Authentication_Factory;
             Priorities : String
          );

This procedure sets priorities for the authentication. If not set explicitly, "NORMAL" is used.

A minimal initialization of a X.509 connection factory may set a keys pair generated by a tool like OpenSSL, e.g.

Add_Key_From_PEM_File
(  Factory          => Factory,
   Certificate_File => "cert.pem",
   Key_File         => "key.pem"
);

Anonymous authentication factory

The package GNAT.Sockets.Server.Secure.Anonymous provides an implementation of connection factory for anonymous authentication.

type Anonymous_Authentication_Factory is abstract
   new
Connections_Factory with private;

Custom factories must be derived from this base type. The following primitive operations are defined:

procedure Set_Priorities
          (  Factory    : in out Anonymous_Authentication_Factory;
             Priorities : String
          );

This procedure sets priorities for the authentication. If not set explicitly, "NORMAL" is used.

17.1.4. Secure OpenSSL servers

The package GNAT.Sockets.Server.OpenSSL provides an implementation of the connection server with a secure SSL/TLS layer, e.g. HTTPS, based on OpenSSL. The architecture of secure SSL/TLS communication is that the encryption layer sits on top of the TCP/IP stream. The original protocol (e.g. HTTP) exchange is not altered. The server's outgoing traffic goes to the SSL/TLS layer and gets encrypted before sending it over the socket. Correspondingly, the incoming traffic is first decrypted and then routed to the original protocol. The server supports both incoming and outgoing encrypted connections. Right after a connection is established a handshake is performed by the SSL/TLS layer. When the handshake is successful the exchange is started to proceed as described above.

The implementation of SSL/TLS layer in this package is based on the OpenSSL library. The following abstract data type implements an abstract SSL/TLS connections factory:

type Abstract_OpenSSL_Factory
     (  Decoded_Size : Buffer_Length
     )  is abstract new Connections_Factory with private;

Custom factories must be derived from this base type. When a connection to the client is first established, the server using a factory derived from this type engages a handshaking which includes exchange of certificates. When the handshaking is successful the following exchange continues encrypted. There is no need to change anything in the original protocol implementation. Both secure and insecure factories may use same client connection objects. The factory contains OpenSSL server and client contexts created as required. The contexts kept in the factory are identified using this enumeration type:

type Context_Type is (Client_Context, Any_Context, Server_Context);

Note that TLS encoding introduces per-record encoding overhead. Thus smaller portions of sent data have relatively higher overhead. In order to prevent excessive fragmentation the output buffer (discriminant Output_Size of Connection object) should be reasonable large.

The following primitive operations are defined on Abstract_OpenSSL_Factory:

procedure Check_Private_Key
          (  Factory : in out Abstract_OpenSSL_Factory;
             Context : Context_Type
          );

This procedure checks the consistency of a private key with the corresponding certificate as set in the factory. The parameter Context specifies the key of which contexts must be checked. Constraint_Error is propagated if the check fail.

procedure Clear_Options
          (  Factory : in out Abstract_OpenSSL_Factory;
             Context : Context_Type;
             Options : SSL_OP
          );

This procedure clears option bits specified by the parameter Options. The parameter Context specifies the contexts which option bits must be cleared. Sessions inherit options set by the corresponding context. The option bits are defined in the package OpenSSL, see OpenSSL options for further information.

function Get_Name_Of_Cipher
         (  Factory : in out Abstract_OpenSSL_Factory;
            Context : Context_Type;
            Index   : Positive
         )  return String;

This function returns the name of the available cipher by its number. The parameter Context specifies the contexts to look for cipher. When both client and server contexts apply the client context ciphers are enumerated first. Constraint_Error is propagated when Index is greater Get_Number_Of_Ciphers.

function Get_Number_Of_Ciphers
         (  Factory : in out Abstract_OpenSSL_Factory;
            Context : Context_Type
         )  return Natural;

This function returns the number of the available cipher by its number. The parameter Context specifies the contexts to look for cipher. When both client and server contexts apply the client context ciphers are enumerated first.

function Get_Options
 
        (  Factory : in out Abstract_OpenSSL_Factory;
            Context : Context_Type
         )  return SSL_OP;

This function returns the options in effect. When Context is Any_Context the result is or-combination of the options of a contexts. See OpenSSL options for further information.

procedure Get_Proto_Version
 
         (  Factory : in out Abstract_OpenSSL_Factory;
             Context : Context_Type;
             Minimal : out SSL_Version_No;
             Maximal : out SSL_Version_No
          );

This procedure returns the minimal and maximal SSL versions. The version type and constants are defined in the package OpenSSL. When Context specifies several contexts Minimal is the maximum and Maximal is the minimum of the corresponding versions. The version constraint is inherited by sessions from the context. The procedure Set_Proto_Version sets the constraints.

procedure Handshake_Completed
          (  Factory : in out Abstract_OpenSSL_Factory;
             Client  : in out Connection'Class;
             Session : SSL
          );

This procedure is called upon TLS handshake completion. The implementation may use it in order to check the session, e.g. verifying client's certificates. The default does nothing. When Connection_Error is propagated the connection is silently dropped. Other exceptions drop connection as well.

function Is_Trace_Decoded
         (  Factory : Abstract_OpenSSL_Factory
         )  return Boolean;

This function returns true if tracing of original protocol output is enabled. See Set_TLS_Tracing.

function Is_Trace_Session
         (  Factory : Abstract_OpenSSL_Factory
         )  return Boolean;

This function returns true if tracing of TLS session state changes is enabled. See Set_TLS_Tracing.

procedure Load_Verify_Locations
          (  Factory : in out Abstract_OpenSSL_Factory;
             Context : Context_Type;
             CA_File : String := "";
             CA_Path : String := ""
          );

This procedure specifies the locations at which CA certificates for verification purposes are located. The certificates available via CA_File and CA_Path are trusted. The parameter Context specifies the contexts which must be modified.

procedure Prepare
          (  Factory : in out Abstract_OpenSSL_Factory;
             Client  : in out Connection'Class;
             Session : SSL
          );

This abstract primitive operation is called when a connection is established. Client is the client connection object. Note that Prepare is called prior to Connected. The objective of Prepare is to set up the TLS session specified by the Session parameter. This normally includes setting certificates and keys into Session. The default implementation does nothing.

procedure Set_Cipher_List
          (  Factory : in out Abstract_OpenSSL_Factory;
             Context : Context_Type;
             List    : String
          );

This procedure sets the list of available ciphers (TLS 1.2 and below) for the contexts specified by the parameter Context. The format of the string List is described in ciphers. The list of ciphers is inherited by all sessions corresponding to the context. This procedure does not impact TLS 1.3 cipher suites. Use Set_Cipher_Suites instead. Use_Error is propagated on errors.

procedure Set_Cipher_Suites
          (  Factory : in out Abstract_OpenSSL_Factory;
             Context : Context_Type;
             List    : String
          );

This procedure is used to configure the available TLS 1.3 cipher suites for the contexts specified by the parameter Context. The format of the string List is a simple colon separated list of TLS 1.3 cipher suite names in order of preference. The valid TLS 1.3 cipher suite names are:

An empty list is permissible. The default is TLS_AES_256_GCM_SHA384:TLS_CHACHA20_POLY1305_SHA256:TLS_AES_128_GCM_SHA256. Use_Error is propagated on errors.

procedure Set_Default_Verify_Dir
          (  Factory : in out Abstract_OpenSSL_Factory;
             Context : Context_Type
          );

This procedure specifies the default directory from which CA certificates are loaded. There is one default directory and one default file. This procedure sets the directory. Use_Error is propagated on errors. See also Set_Default_Verify_Paths.

procedure Set_Default_Verify_File
          (  Factory : in out Abstract_OpenSSL_Factory;
             Context : Context_Type
          );

This procedure specifies the default directory from which CA certificates are loaded. There is one default directory and one default file. This procedure sets the file. Use_Error is propagated on errors. See also Set_Default_Verify_Paths.

procedure Set_Default_Verify_Paths
          (  Factory : in out Abstract_OpenSSL_Factory;
             Context : Context_Type
          );

This procedure specifies that the default locations from which CA certificates are loaded should be used. There is one default directory and one default file. The default CA certificates directory called certs in the default OpenSSL directory. Alternatively the SSL_CERT_DIR environment variable can be defined to override this location. The default CA certificates file is called cert.pem in the default OpenSSL directory. Alternatively the SSL_CERT_FILE environment variable can be defined to override this location. Use_Error is propagated on errors.

procedure Set_Options
          (  Factory : in out Abstract_OpenSSL_Factory;
             Context : Context_Type;
             Options : SSL_OP
          );

This procedure set option bits specified by the parameter Options. The parameter Context specifies the contexts which option bits must be set. Sessions inherit options set by the corresponding context. The option bits are defined in the package OpenSSL, see OpenSSL options for further information.

procedure Set_Proto_Version
          (  Factory : in out Abstract_OpenSSL_Factory;
             Context : Context_Type;
             Minimal : SSL_Version_No;
             Maximal : SSL_Version_No
          );

This procedure sets the version constraint on the contexts specified by the parameter Context. Sessions the constraint set in the the corresponding context. The version type and constants are defined in the package OpenSSL.

procedure Set_TLS_Tracing
          (  Factory : in out Abstract_OpenSSL_Factory;
             Session : Boolean;
             Decoded : Boolean
          );

This procedure enables or disables tracing of the decoded output and/or TLS session state changes.

procedure Use_Certificate_ASN1
          (  Factory     : in out Abstract_OpenSSL_Factory;
             Context     : Context_Type;
             Certificate : Stream_Element_Array
          );

This procedure sets the certificate located in the memory specified by the parameter Certificate into the contexts defined by the parameter Context. The certificate format is ASN1. Use_Error is propagated on errors.

WARNING! The version 1.1.1a of OpenSSL has a bug that Use_Certificate and Use_Key calls pair do not work. The application should always check the effect by calling Check_Private_Key to verify the effect. The corresponding calls on the session works, thus as a workaround one should use them instead from the Prepare callback.

procedure Use_Certificate_Chain_File
          (  Factory : in out Abstract_OpenSSL_Factory;
             Context : Context_Type;
             File    : String
          );

This procedure loads a certificate chain from file. The certificates must be in PEM format and must be sorted starting with the subject's certificate (actual client or server certificate), followed by intermediate CA certificates if applicable, and ending at the highest level (root) CA. Use_Error is propagated on errors.

procedure Use_Certificate_{ASN1|PEM}_File
          (  Factory : in out Abstract_OpenSSL_Factory;
             Context : Context_Type;
             File    : String
          );

These procedures specify the certificate from a file. The file format is ASN1 or PEM according to the name. Use_Error is propagated on errors.

procedure Use_{RSA_}Key_ASN1
          (  Factory : in out Abstract_OpenSSL_Factory;
             Context : Context_Type;
             Key     : Stream_Element_Array
          );

These procedures specify the key from memory. The format is ASN1. The variant with RSA in the name deals with RSA keys. If a certificate has already been set and the private key does not belong to the certificate an error is returned. To change a certificate, private key pair the new certificate needs to be set before setting the private key. Use_Error is propagated on errors.

procedure Use_{RSA_}Key_{ASN1|PEM}_File
          (  Factory : in out Abstract_OpenSSL_Factory;
             Context : Context_Type;
             File    : String
          );

These procedures specify the key from a file. The file format can be ASN1 or PEM. The variant with RSA in the name deals with RSA keys. If a certificate has already been set and the private key does not belong to the certificate an error is returned. To change a certificate, private key pair the new certificate needs to be set before setting the private key. Use_Error is propagated on errors.

OpenSSL Session

For each connection handled by an Abstract_OpenSSL_Factory there is an OpenSSL session object which controls encryption and decryption. factory. Its type SSL defined in the package OpenSSL. The object inherits most of its settings from the corresponding context. The procedures Prepare and Handshake_Completed pass the parameter Session of the type SSL. The object can be manipulated using the following subroutines most of which have a counterpart operation of Abstract_OpenSSL_Factory that does the same for the context.

procedure Check_Private_Key (Session : SSL);

This procedure checks the consistency of a private key with the corresponding certificate as set for the session. Constraint_Error is propagated if the check fail.

procedure Clear_Options
          (  Session : SSL;
             Options : SSL_OP
          );

This procedure clears option bits specified by the parameter Options. The option bits are defined in the package OpenSSL, see OpenSSL options for further information.

function Get_Cipher_List
         (  Session  : SSL;
            Priority : int
         )  return String;

This function returns the list of ciphers with the priority greater or equal .

function Get_Name_Of_Cipher
         (  Session : SSL;
            Index   : Positive
         )  return String;

This function returns the name of the available cipher by its number. Constraint_Error is propagated when Index is out of range.

function Get_Name_Of_Client_Cipher
         (  Session : SSL;
            Index   : Positive
         )  return String;

This function returns the name of a cipher supported by the client. Constraint_Error is propagated when Index is out of range.

function Get_Name_Of_Supported_Cipher
         (  Session : SSL;
            Index   : Positive
         )  return String;

This function returns the name of an advertised to the client cipher by its number. Constraint_Error is propagated when Index is out of range.

function Get_Number_Of_Ciphers (Session : SSL) return Natural;

This function returns the number of cipher supported by the client. It is always zero for a client session.

function Get_Number_Of_Client_Ciphers (Session : SSL) return Natural;

This function returns the number of ciphers as advertised to the client.

function Get_Number_Of_Supported_Ciphers (Session : SSL) return Natural;

This function returns the number of ciphers as advertised to the client.

function Get_Options (Session : SSL) return SSL_OP;

This function returns the options in effect. See OpenSSL options for further information.

procedure Get_Proto_Version
 
         (  Session : SSL;
             Minimal
: out SSL_Version_No;
             Maximal : out SSL_Version_No
          );

This procedure returns the minimal and maximal SSL versions. The version type and constants are defined in the package OpenSSL.

function Get_Shared_Ciphers (Session : SSL) return String;

This function returns a colon separated of cipher names that are available in both the client and the server.

procedure Set_Cipher_List
          (  Session : SSL;
             List
    : String
          );

This procedure sets the list of available ciphers (TLS 1.2 and below) for the session. The format of the string List is described in ciphers. The list of ciphers is inherited by all sessions corresponding to the context. This procedure does not impact TLS 1.3 cipher suites. Use_Error is propagated on errors.

procedure Set_Cipher_Suites
          (  Session : SSL;
             List
    : String
          );

This procedure is used to configure the available TLS 1.3 cipher suites for the session. The format of the string List is a simple colon separated list of TLS 1.3 cipher suite names in order of preference. The valid TLS 1.3 cipher suite names are:

An empty list is permissible. The default is TLS_AES_256_GCM_SHA384:TLS_CHACHA20_POLY1305_SHA256:TLS_AES_128_GCM_SHA256. Use_Error is propagated on errors.

procedure Set_Options
          (  Factory : in out Abstract_OpenSSL_Factory;
             Context : Context_Type;
             Options : SSL_OP
          );

This procedure set option bits specified by the parameter Options. The parameter Context specifies the contexts which option bits must be set. Sessions inherit options set by the corresponding context. The option bits are defined in the package OpenSSL, see OpenSSL options for further information.

procedure Set_Proto_Version
          (  Session : SSL;
             Minimal
: SSL_Version_No;
             Maximal : SSL_Version_No
          );

This procedure sets the version constraint for the session. The version type and constants are defined in the package OpenSSL.

procedure Use_Certificate_ASN1
          (  Session     : SSL;
             Certificate
: Stream_Element_Array
          );

This procedure sets the certificate located in the memory specified by the parameter Certificate into the session. The certificate format is ASN1. Use_Error is propagated on errors.

procedure Use_Certificate_Chain_File
          (  Session : SSL;
             File
    : String
          );

This procedure loads a certificate chain from file. The certificates must be in PEM format and must be sorted starting with the subject's certificate (actual client or server certificate), followed by intermediate CA certificates if applicable, and ending at the highest level (root) CA. Use_Error is propagated on errors.

procedure Use_Certificate_{ASN1|PEM}_File
          (  Session : SSL;
             File
    : String
          );

These procedures specify the certificate from a file. The file format is ASN1 or PEM according to the name. Use_Error is propagated on errors.

procedure Use_{RSA_}Key_ASN1
          (  Session : SSL;
             Key
    : Stream_Element_Array
          );

These procedures specify the key from memory. The format is ASN1. The variant with RSA in the name deals with RSA keys. If a certificate has already been set and the private key does not belong to the certificate an error is returned. To change a certificate, private key pair the new certificate needs to be set before setting the private key. Use_Error is propagated on errors.

procedure Use_{RSA_}Key_{ASN1|PEM}_File
          (  Session : SSL;
             File
   : String
          );

These procedures specify the key from a file. The file format can be ASN1 or PEM. The variant with RSA in the name deals with RSA keys. If a certificate has already been set and the private key does not belong to the certificate an error is returned. To change a certificate, private key pair the new certificate needs to be set before setting the private key. Use_Error is propagated on errors.

17.1.5. Simple echo server sample

The following sample illustrates implementation of a simple echo server. The server sends back to the client what it receives from it. The package Test_Echo_Servers contains the implementation:

File test_echo_servers.ads:
with Ada.Exceptions;       use Ada.Exceptions;
with Ada.Streams;          use Ada.Streams;
with GNAT.Sockets;         use GNAT.Sockets;
with GNAT.Sockets.Server;  use GNAT.Sockets.Server;

package Test_Echo_Servers is

   type Echo_Factory is new Connections_Factory with private;
   function Create
            (  Factory  : access Echo_Factory;
               Listener : access Connections_Server'Class;
               From     : Sock_Addr_Type
            )  return Connection_Ptr;
   procedure Trace
             (  Factory    : in out Echo_Factory;
                Context    : String;
                Occurrence : Exception_Occurrence
             );

   type Echo_Connection is new Connection with private;
   procedure Finalize (Client : in out Echo_Connection);
   procedure Received
             (  Client  : in out Echo_Connection;
                Data    : Stream_Element_Array;
                Pointer : in out Stream_Element_Offset
             );
private
   type
Echo_Factory is new Connections_Factory with null record;

   type Echo_Connection is new Connection with record
      From : Sock_Addr_Type;
   end record;
end Test_Echo_Servers;

Here Echo_Server is the server object. Echo_Connection is the corresponding connection object.

File test_echo_servers.adb:
with Ada.Text_IO;  use Ada.Text_IO;

package body Test_Echo_Servers is
   function Create
            (  Factory  : access Echo_Factory;
               Listener : access Connections_Server'Class;
               From     : Sock_Addr_Type
            )  return Connection_Ptr is
 
    Result : Connection_Ptr;
   begin
 
    Put_Line ("Connected client at " & Image (From));
      Result := new Echo_Connection (80, 120);
      Echo_Connection (Result.all).From := From;
      return Result;
   end Admit;

   procedure Finalize (Client : in out Echo_Connection) is
   begin
   
  Put_Line ("Disconnected client " & Image (Client.From));
      Finalize (Connection (Client));
   end Finalize;

   procedure Received
             (  Client  : in out Echo_Connection;
                Data    : Stream_Element_Array;
                Pointer : in out Stream_Element_Offset
             )  is
 
 begin
 
    Pointer := Data'First;
      Send (Client, Data, Pointer);
      if Pointer /= Data'Last + 1 then
       
 Put_Line
         (  "Error sending"
         &  Stream_Element_Offset'Image (Data'Last - Pointer + 1)
         &  " elements"
         );
      end if;
   end Received;

   procedure Trace
             (  Factory    : in out Echo_Factory;
                Context    : String;
                Occurrence : Exception_Occurrence
             ) is
   begin
 
    Put_Line (Context & ':' & Exception_Information (Occurrence));
   end Trace;
end Test_Echo_Servers;

17.1.6. Blocking I/O servers

Normally the implementations of connection object are used for non-blocking I/O with a socket selector. The same objects however can be used with traditional blocking I/O, e.g. using serial communication transport. The package GNAT.Sockets.Server.Blocking provides connection servers handling blocking I/O channels. It declares the server type:

type Blocking_Server
     (  Factory       : access Connections_Factory'Class;
        Input_Stream  : access Root_Stream_Type'Class;
        Output_Stream : access Root_Stream_Type'Class;
        Input_Size    : Positive
     )  is new Connections_Server with private;

The discriminants of the type are:

The connections server handles exactly one connection. The corresponding server or client is considered always connected. The first call must be a call to Connect that provides the server or client connection. Note that since the communication channel is considered preexisting there is no difference between server and client. Both will use Connect.

The following primitive operations are provided additionally to the inherited ones:

procedure Cancel_IO
          (  Listener : in out Blocking_Server;
             Client   : in out Connection'Class
          );

This procedure is used by the server upon finalization and handling errors in order to cancel any pending I/O. It is called asynchronously to the tasks blocked on I/O. For example when a serial connection is used it would close the communication port handle or file.

function Get_Peer (Listener : Blocking_Server)
   return
GNAT.Sockets.Server.Handles.Handle;

This function returns a handle to the connection object used by the server.

function Get_Read_Timeout (Listener : Blocking_Server)
   return
Duration;

This function returns sets the read timeout (see Set_Read_Timeout).

procedure On_Reader_Start (Listener : in out Blocking_Server);

This procedure is called once when the reader task starts. The default implementation does nothing.

procedure On_Writer_Start (Listener : in out Blocking_Server);

This procedure is called once when the reader task starts. The default implementation does nothing.

procedure Set_Read_Timeout
          (  Listener : in out Blocking_Server;
             Timeout  : Duration := Duration'Last
          );

This procedure sets the read timeout. The value limits the time the reader waits for an input. Normally, when reading from a serial point the input timeout expiring does not cause error. The next attempt to read is made instead. In order to prevent infinite waiting when the counterpart never sends anything the read timeout is applied. When expired further reading attempts are prevented and an input error is propagated instead. The timeout is set per octet read.

procedure Wait_For_Tasks
          (  Listener : in out Blocking_Server;
             Timeout  : Duration;
             Kill     : Boolean
          );

This procedure awaits for the reader and writer tasks to complete. When Kill is true upon timeout expiration the tasks are aborted and no exception is propagated.

[Back][TOC][Next]

17.2. Connection state machine

The package GNAT.Sockets.Connection_State_Machine provides an implementation of a server's side connection object that deploys a state machine to receive packets from the client side. The structure of a packet is described by the contents of connection object itself. Fields of the object derived from a special abstract type (Data_Item) fed with the input received from the client in the order they are declared in the object. Once all fields are received a primitive operation is called to process the packet. After that the cycle repeats. Enumeration of the fields (introspection) is based on Ada stream attributes. See Ada RM 13.13.2(9) for the legality of the approach.

17.2.1. State machine connection object

The package GNAT.Sockets.Connection_State_Machine declares the state machine connection object:

type State_Machine is abstract
   new
Connection with private;

The connection object implements the operations of the base type:

When Connected, Disconnected or Finalize are overridden the new implementation shall call them from its body. The implementation of Received inputs the fields of the derived type, which themselves are derived from Data_Item. The fields can be direct members of the derived type or members of members. A derived type may override Received in its turn if it wishes to process some parts of the input without sending it to the input fields.

procedure Enumerate
          (  Stream : access Root_Stream_Type'Class;
             Item   : State_Machine
          );
for State_Machine'Write use Enumerate;

This procedure is used internally in order to enumerate the contents of the extension record type. The derived type shall not override either this procedure or the stream attribute write.

17.2.2. State machine data items

The package GNAT.Sockets.Connection_State_Machine declares the abstract base type of the items comprising a packet:

type Data_Item is abstract
   new
Ada.Finalization.Limited_Controlled with null record;
type
Data_Item_Ptr is access all Data_Item'Class;
type
Data_Item_Offset is new Integer;
subtype
Data_Item_Address is Data_Item_Offset
   range 1..Data_Item_Offset'Last;
type
Data_Item_Ptr_Array is
   array
(Data_Item_Address range <>) of Data_Item_Ptr;

The packet is read by the implementation Received. The data items are read in the order defined by the positional aggregate of the server object.

procedure Feed
          (  Item    : in out Data_Item;
             Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Client  : in out State_Machine'Class;
             State   : in out Stream_Element_Offset
          )  is abstract;

This procedure is called from Received when data become available to get the contents of Item. The stream elements are Data (Pointer..Data'Last). The procedure consumes data and advances Pointer beyond consumed elements. The parameter State indicates processing state. It is initially 0. When Item contents is read in full State is set to 0. When State is not 0 then Pointer must be set to Data'Last, which indicates that more data is required. Feed will be called again on the item when new data come with the value of State returned from the last call.

procedure Freed (Item : in out Data_Item);

This procedure is called when the shared data item is about to deallocate items allocated there. See External_String_Buffer. The default implementation does nothing.

function Get_Children (Item : Data_Item) return Data_Item_Ptr_Array;

This procedure is called when the shared data item is about to deallocate items allocated there. See External_String_Buffer.

function Get_Size (Item : Data_Item) return Natural;

This function returns the number of data items contained in Item, including it itself. For scalar data items the result is 1, which is the default implementation.

procedure End_Of_Subsequence
          (  Item    : in out Data_Item;
             Data    : Stream_Element_Array;
             Pointer : Stream_Element_Offset;
             Client  : in out State_Machine'Class;
             State   : in out Stream_Element_Offset
          )  is abstract;

This procedure is used by implementations of aggregate data items which contain other items. Contained items are organized in subsequences called recursively. When a subsequence of data items has been processed this procedure is called. Item is the data item which was active prior to the subsequence start. It is called only if the data item was not already completed, i.e. State was not 0 prior to invoking the subsequence. When the implementation changes State to 0 processing of the data item completes and the next item is fetched. Note that differently to Feed Pointer may point beyond Data when all available input has been processed. The default implementation does nothing.

procedure External_Initialize
          (  Item   : Data_Item'Class;
             Shared : Shared_Data_Item_Ptr := null
          );

This procedure is used to initialize an object when it is used outside an instance of State_Machine. For example, when Feed need to be called directly on the object without an actual connection and any physical socket I/O the object must be initialized with this procedure first.

procedure Enumerate
          (  Stream : access Root_Stream_Type'Class;
             Item   : Data_Item
          );
for Data_Item'Write use Enumerate;

This procedure is used internally in order to enumerate the contents of the record type, a descendant of State_Machine. The derived type shall not override either this procedure or the stream attribute write.

17.2.3. Block of data items

The package GNAT.Sockets.Connection_State_Machine declares the container data type:

type Data_Block is abstract new Data_Item with private;

The data type is used by deriving a custom type and putting other data item types into the extension record: E.g.

type Four_Numbers is new Data_Block with record
   N1 : Unsigned_8_Data_Item;
   N2 : Unsigned_16_Data_Item;
   N3 : Unsigned_16_Data_Item;
   N4 : Unsigned_16_Data_Item;
end record;

The following primitive operation is additionally declared:

function Get_Length (Item : Data_Block) return Positive;

The function returns the number of direct items the block contains. Note that it is different from Get_Size which returns all data items.

17.2.4. Null data item

The package GNAT.Sockets.Connection_State_Machine declares:

type Data_Null is new Data_Item with private;

This data item can be used when an item is expected, e.g. as an alternative of a data item selector.

17.2.5. Data items selector

The package GNAT.Sockets.Connection_State_Machine declares:

type Data_Selector is abstract new Data_Item with private;

The data items of the extension are selected alternatively. A derived type has fields derived from Data_Item. One of the fields is used at a time. So the type acts as a variant record. The field to select is set by calling Set_Alternative. Usually it is done from Feed of some descendant derived from Data_Item, placed after the field controlling selection of the alternative. When an alternative should enclose several fields a Data_Block descendant is used. An empty alternative contains Data_Null.

function Get_Alternative (Item : Data_Selector) return Positive;

This function returns the currently selected alternative. The alternative is usually selected by the contents of the items preceding the selector using Set_Alternative.

function Get_Alternatives_Number (Item : Data_Selector)
   return Positive;

This function returns the total number of alternatives. Use_Error is propagated when the selector item was not initialized yet.

procedure Set_Alternative
          (  Item        : in out Data_Selector;
             Alternative : Positive
          );

This function selects an alternative. Constraint_Error is propagated when Alternative is invalid. Use_Error is propagated when the selector item was not initialized yet. The following sample illustrates usage of selector:

type Alternative_1 is new Data_Block with record
   N : Integer_16_Data_Item;
end record;
type Alternative_2 is new Data_Block with record
   L : Unsigned_32_Data_Item;
   M : Unsigned_32_Data_Item;
end record;
type Variant is new Data_Selector with record
   A1   : Alternative_1;
   A2   : Alternative_2;
   Text : String_Data_Item (80, Character'Val (0));
   None : Data_Null;
end record;

The above selector can be put into a connection object. The following snippet illustrates how to add a selection of the alternative controlled by an item preceding the selector:

type Data_Connection;
type Setter
     (  Parent : access Data_Connection
     )  is new Data_Item with null record;
procedure Feed
          (  Item    : in out Setter;
             Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Client  : in out State_Machine'Class;
             State   : in out Stream_Element_Offset
          );
type Data_Connection is new State_Machine with record
   Control : Unsigned_8_Data_Item;
   Fix     : Setter (Data_Connection'Unchecked_Access);
   Tail    : Variant;
end record;

The implementation of Feed goes follows:

procedure Feed
          (  Item    : in out Setter;
             Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Client  : in out State_Machine'Class;
             State   : in out Stream_Element_Offset
          )  is
begin
   Set_Alternative
   (  Setter.Parent.Tail,
      Setter.Parent.Control.Value
   );
   State := 0;
end Feed;

17.2.6. External string buffer and arena pool

It is sometimes required to have Data_Item instances allocating data dynamically. Such allocations occur in FIFO order which is suitable for an arena pool. The package GNAT.Sockets.Connection_State_Machine declares a special Data_Item type:

type External_String_Buffer (Size : Natural) is
   new
Shared_Data_Item with
record

   Pool       : Arena_Pool (External_String_Buffer'Access);
   Length     : Natural := 0;
   Count      : Natural := 0;       -- Allocatied items
   Allocators : Allocator_Data_Ptr; -- List of objects using the pool
   Buffer     : String (1..Size);
end record;
type External_String_Buffer_Ptr is
   access all
External_String_Buffer'Class;

The data item is placed in front of the of the Data_Item objects that designed to allocate their data there. The following sample illustrates usage of the buffer:

type Alternatives_Record is new Choice_Data_Item with record
   Text_1 : Implicit_External_String_Data_Item;
   Text_2 : Implicit_External_String_Data_Item;
   Text_3 : Implicit_External_String_Data_Item;
end record;
type Packet is new State_Machine ... with record
   Buffer : External_String_Buffer (1024); -- Shared buffer
   Choice : Alternatives_Record;
end record;

Here the alternative selected by Choice will be allocated in Buffer, so that there is no need to have space for all alternatives in Packet.

procedure Erase (Buffer : in out External_String_Buffer);

The implementation walks the list of allocators to notify them that the allocated items will be freed. The callee (Freed) must finalize its elements if necessary.

procedure Feed
          (  Item    : in out External_String_Buffer;
             Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Client  : in out State_Machine'Class;
             State   : in out Stream_Element_Offset
          );

The implementation of Feed calls Erase to clean the buffer.

procedure Finalize (Buffer : in out External_String_Buffer);

This procedure must be called from the new implementation if overridden.

type Arena_Pool
     (  Parent : access External_String_Buffer'Class
     )  is new System.Storage_Pools.Root_Storage_Pool with
           null record
;

This is the type of the pool component of the External_String_Buffer that allocates memory as substrings in the buffer.

type Allocator_Data (Allocator : access Data_Item'Class) is record
   Previous : Allocator_Data_Ptr; -- List of allocators
end record;
type Allocator_Data_Ptr is access all Allocator_Data;

The pool users register themselves by placing elements of this type in the list of External_String_Buffer. All members of the list are notified from Erase by calling to Freed. The notification is only required when controlled objects are allocated in the arena, in order to call Finalize.

[Back][TOC][Next]

17.3. Data items encoded big-endian

The package GNAT.Sockets.Connection_State_Machine.Big_Endian is the parent of the packages implementing data items which use big-endian encoding.

17.3.1. IEEE 754 double precision float numbers

The package GNAT.Sockets.Connection_State_Machine.Big_Endian.Generic_Double_Precision_IEEE_754 is a generic implementation of big-endian encoded double precision IEEE 754 floats:

generic
   with package
IEEE_Double_Precision is
      new
IEEE_754.Generic_Double_Precision (<>);
package GNAT.Sockets.Connection_State_Machine.Big_Endian.
        Generic_Double_Precision_IEEE_754 is
   use
IEEE_Double_Precision;

The package defines the data item type:

type IEEE_754_Data_Item is new Data_Item with record
  
Value : Float_64;
end record
;

The component Value is the input data as declared in IEEE_754.Generic_Double_Precision. The following operations are defined on the type:

function Get_Value (Item : IEEE_754_Data_Item) return Number;

This function returns the value contained by the item. It propagates the following exceptions: Not_A_Number_Error, Positive_Overflow_Error, Negative_Overflow_Error.

Additionally the package provides:

procedure Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : out Float_64
          );
procedure
Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : out Number
          );

These procedure get a value from Data starting at Data (Pointer). Pointer is advanced beyond the input value. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there is not enough data. The variant returning a floating-point number additionally raises Not_A_Number_Error, Positive_Overflow_Error, Negative_Overflow_Error.

procedure Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Float_64
          );
procedure
Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Number
          );

Thes procedures put a value into Data starting at Data (Pointer). Pointer is advanced beyond the input value. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there is no room for output.

The package GNAT.Sockets.Connection_State_Machine.Big_Endian.IEEE_754_Long_Floats provides an instantiation of Generic_Double_Precision_IEEE_754 with the type Long_Float.

17.3.2. IEEE 754 single precision float numbers

The package GNAT.Sockets.Connection_State_Machine.Big_Endian.Generic_Single_Precision_IEEE_754 is a generic implementation of big-endian encoded single precision IEEE 754 floats:

generic
   with package
IEEE_Single_Precision is
      new
IEEE_754.Generic_Single_Precision (<>);
package GNAT.Sockets.Connection_State_Machine.Big_Endian.
        Generic_Single_Precision_IEEE_754 is
   use
IEEE_Single_Precision;

The package defines the data item type:

type IEEE_754_Data_Item is new Data_Item with record
  
Value : Float_32;
end record
;

The component Value is the input data as declared in IEEE_754.Generic_Single_Precision. The following operations are defined on the type:

function Get_Value (Item : IEEE_754_Data_Item) return Number;

This function returns the value contained by the item. It propagates the following exceptions: Not_A_Number_Error, Positive_Overflow_Error, Negative_Overflow_Error.

Additionally the package provides:

procedure Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : out Float_32
          );
procedure
Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : out Number
          );

These procedure get a value from Data starting at Data (Pointer). Pointer is advanced beyond the input value. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there is not enough data. The variant returning a floating-point number additionally raises Not_A_Number_Error, Positive_Overflow_Error, Negative_Overflow_Error.

procedure Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Float_32
          );
procedure
Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Number
          );

These procedures put a value into Data starting at Data (Pointer). Pointer is advanced beyond the input value. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there is no room for output.

The package GNAT.Sockets.Connection_State_Machine.Big_Endian.IEEE_754_Floats provides an instantiation of Generic_Single_Precision_IEEE_754 with the type Float.

17.3.3. Signed integers

The package GNAT.Sockets.Connection_State_Machine.Big_Endian.Integers provides data items of for big-endian 2's complement encoded integer types:

type Integer_n_Data_Item is new Data_Item with private;

where n = 8, 16, 32, 64. These types correspond to the integer types declared in the standard package Interfaces (Ada RM B.2). For each type the following primitive operations are provided:

function Value (Item : Integer_n_Data_Item) return Integer_n;

This function returns the value contained by the item.

Additionally the package declares:

procedure Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : out Integer_n
          );

These procedure get a value from Data starting at Data (Pointer). Pointer is advanced beyond the input value. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there is not enough data.

procedure Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Integer_n
          );

Thes procedures put a value into Data starting at Data (Pointer). Pointer is advanced beyond the input value. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there is no room for output.

17.3.4. Unsigned integers

The package GNAT.Sockets.Connection_State_Machine.Big_Endian.Unsigneds provides data items of for big-endian encoded integer types:

type Unsigned_n_Data_Item is new Data_Item with record
   Value : Unsigned_n;
end record;

where n = 8, 16, 32, 64. The types correspond to the integer types declared in the standard package Interfaces (Ada RM B.2).

Additionally the package declares:

procedure Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : out Unsigned_n
          );

These procedure get a value from Data starting at Data (Pointer). Pointer is advanced beyond the input value. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there is not enough data.

procedure Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Unsigned_n
          );

These procedures put a value into Data starting at Data (Pointer). Pointer is advanced beyond the input value. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there is no room for output.

[Back][TOC][Next]

17.4. Data items encoded little-endian

The package GNAT.Sockets.Connection_State_Machine.Little_Endian is the parent of the packages implementing data items which use little-endian encoding.

17.4.1. IEEE 754 double precision float numbers

The package GNAT.Sockets.Connection_State_Machine.Little_Endian.Generic_Double_Precision_IEEE_754 is a generic implementation of little-endian encoded double precision IEEE 754 floats:

generic
   with package
IEEE_Double_Precision is
      new
IEEE_754.Generic_Double_Precision (<>);
package GNAT.Sockets.Connection_State_Machine.Little_Endian.
        Generic_Double_Precision_IEEE_754 is
   use
IEEE_Double_Precision;

The package defines the data item type:

type IEEE_754_Data_Item is new Data_Item with record
  
Value : Float_64;
end record
;

The component Value is the input data as declared in IEEE_754.Generic_Double_Precision. The following operations are defined on the type:

function Get_Value (Item : IEEE_754_Data_Item) return Number;

This function returns the value contained by the item. It propagates the following exceptions: Not_A_Number_Error, Positive_Overflow_Error, Negative_Overflow_Error.

Additionally the package provides:

procedure Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : out Float_64
          );
procedure
Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : out Number
          );

These procedure get a value from Data starting at Data (Pointer). Pointer is advanced beyond the input value. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there is not enough data. The variant returning a floating-point number additionally raises Not_A_Number_Error, Positive_Overflow_Error, Negative_Overflow_Error.

procedure Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Float_64
          );
procedure
Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Number
          );

Thes procedures put a value into Data starting at Data (Pointer). Pointer is advanced beyond the input value. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there is no room for output.

The package GNAT.Sockets.Connection_State_Machine.Little_Endian.IEEE_754_Long_Floats provides an instantiation of Generic_Double_Precision_IEEE_754 with the type Long_Float.

17.4.2. IEEE 754 single precision float numbers

The package GNAT.Sockets.Connection_State_Machine.Little_Endian.Generic_Single_Precision_IEEE_754 is a generic implementation of little-endian encoded single precision IEEE 754 floats:

generic
   with package
IEEE_Single_Precision is
      new
IEEE_754.Generic_Single_Precision (<>);
package GNAT.Sockets.Connection_State_Machine.Little_Endian.
        Generic_Single_Precision_IEEE_754 is
   use
IEEE_Single_Precision;

The package defines the data item type:

type IEEE_754_Data_Item is new Data_Item with record
  
Value : Float_32;
end record
;

The component Value is the input data as declared in IEEE_754.Generic_Single_Precision. The following operations are defined on the type:

function Get_Value (Item : IEEE_754_Data_Item) return Number;

This function returns the value contained by the item. It propagates the following exceptions: Not_A_Number_Error, Positive_Overflow_Error, Negative_Overflow_Error.

Additionally the package provides:

procedure Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : out Float_32
          );
procedure
Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : out Number
          );

These procedure get a value from Data starting at Data (Pointer). Pointer is advanced beyond the input value. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there is not enough data. The variant returning a floating-point number additionally raises Not_A_Number_Error, Positive_Overflow_Error, Negative_Overflow_Error.

procedure Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Float_32
          );
procedure
Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Number
          );

These procedures put a value into Data starting at Data (Pointer). Pointer is advanced beyond the input value. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there is no room for output.

The package GNAT.Sockets.Connection_State_Machine.Little_Endian.IEEE_754_Floats provides an instantiation of Generic_Single_Precision_IEEE_754 with the type Float.

17.4.3. Signed integers

The package GNAT.Sockets.Connection_State_Machine.Little_Endian.Integers provides data items of for little-endian 2's complement encoded integer types:

type Integer_n_Data_Item is new Data_Item with private;

where n = 8, 16, 32, 64. These types correspond to the integer types declared in the standard package Interfaces (Ada RM B.2). For each type the following primitive operations are provided:

function Value (Item : Integer_n_Data_Item) return Integer_n;

This function returns the value contained by the item.

Additionally the package declares:

procedure Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : out Integer_n
          );

These procedure get a value from Data starting at Data (Pointer). Pointer is advanced beyond the input value. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there is not enough data.

procedure Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Integer_n
          );

These procedures put a value into Data starting at Data (Pointer). Pointer is advanced beyond the input value. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there is no room for output.

17.4.4. Unsigned integers

The package GNAT.Sockets.Connection_State_Machine.Little_Endian.Unsigneds provides data items of for little-endian encoded integer types:

type Unsigned_n_Data_Item is new Data_Item with record
   Value : Unsigned_n;
end record;

where n = 8, 16, 32, 64. The types correspond to the integer types declared in the standard package Interfaces (Ada RM B.2).

Additionally the package declares:

procedure Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : out Unsigned_n
          );

These procedure get a value from Data starting at Data (Pointer). Pointer is advanced beyond the input value. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there is not enough data.

procedure Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Unsigned_n
          );

These procedures put a value into Data starting at Data (Pointer). Pointer is advanced beyond the input value. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there is no room for output.

[Back][TOC][Next]

17.5. Data items encoded using chain code

The package GNAT.Sockets.Connection_State_Machine.Chain_Code is the parent of the packages implementing data items which use chain code encoding. Chain code is a variable length code. An item of the code sequence determines if another item follows. Chain code may have the advantage of lossless compression in the case of integers when lesser values are more frequent, because lesser values are encoded by shorter sequences.

17.5.1. Signed integers

The package GNAT.Sockets.Connection_State_Machine.Chain_Code.Generic_Integer is a generic implementation of chain-encoded signed integer:

generic
   type
Number is range <>;
package
GNAT.Sockets.Connection_State_Machine.Chain_Code.Generic_Integer is ...

The integer number is encoded as follows. The value is first converted to a sequence of bits. The first bit of the sequence is 0 when the value is positive or 1 when negative. The following bits is the little-endian sequence of the absolute value. The sequence ends with the last non-zero bit. Each seven bits of the sequence are packet into an octet. The most significant bit of the octet is 0 for the last octet and 1 otherwise. The following example illustrates encoding principle:

-751210
 751210 = 1_1101_0101_10002
-751210 -> 1011_00012, 0001_11012

Bits colored blue indicate whether the octet end the sequence. The red bit encodes the sign. The package defines the data item type:

type Integer_Data_Item is new Data_Item with record
   Value : Number;
end record
;

The implementation of Feed propagates Data_Error when Number cannot contain the value encoded.

Additionally the package declares:

procedure Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : out Number
          );

This procedure gets a value from Data starting at Data (Pointer). Pointer is advanced beyond the input value. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there is not enough data. Data_Error is propagated when the encoded value is too large.

procedure Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Number
          );

This procedures puts a value into Data starting at Data (Pointer). Pointer is advanced beyond the input value. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there is no room for output.

The package GNAT.Sockets.Connection_State_Machine.Chain_Code.Integers is an instance of Generic_Integer with Integer.

17.5.2. Unsigned integers

The package GNAT.Sockets.Connection_State_Machine.Chain_Code.Generic_Unsigned is a generic implementation of chain-encoded signed integer:

generic
   type
Number is range <>;
package
GNAT.Sockets.Connection_State_Machine.Chain_Code.Generic_Unsigned is ...

Note that the formal parameter Number is a signed integer type.

The unsigned integer number is encoded as follows. The value is first converted to a sequence of bits. The following bits is the little-endian sequence of the absolute value. The sequence ends with the last non-zero bit. Each seven bits of the sequence are packet into an octet. The most significant bit of the octet is 0 for the last octet and 1 otherwise. The following example illustrates encoding principle:

751210 = 1_1101_0101_10002
751210 -> 1111_10002, 0011_10102

Bits colored blue indicate whether the octet end the sequence. The package defines the data item type:

type Unsigned_Data_Item is new Data_Item with record
   Value : Number;
end record
;

The implementation of Feed propagates Data_Error when Number cannot contain the value encoded.

Additionally the package declares:

procedure Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : out Number
          );

This procedure gets a value from Data starting at Data (Pointer). Pointer is advanced beyond the input value. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there is not enough data. Data_Error is propagated when the encoded value is too large.

procedure Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Number
          );

This procedure puts a value into Data starting at Data (Pointer). Pointer is advanced beyond the input value. Constraint_Error is propagated when Value is negative. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there is no room for output.

The package GNAT.Sockets.Connection_State_Machine.Chain_Code.Naturals is an instance of Generic_Unsigned with Natural.

[Back][TOC][Next]

17.6. Strings encoded using a terminator character

The package GNAT.Sockets.Connection_State_Machine.Terminated_Strings provides implementation of items to exchange strings terminated by a special character. The package declares the data item type:

type String_Data_Item
     (  Size       : Positive;
        Terminator : Character
     )  is new Data_Item with
record

   Last  : Natural := 0;
   Value : String (1..Size);
end record
;

The type discriminants are:

The actual string value contained by the data item is Item.Value (1..Item.Last). Or using the function:

function Get_Value (Item : String_Data_Item) return String;

The package also provides a variant with dynamically allocated strings:

type Dynamic_String_Data_Item is new Data_Item with record
   Last       : Natural   := 0;
   Terminator : Character := Character'Val (0);
   Value      : String_Ptr;
end record
;

The following operations are provided:

function Get_Maximum_Size (Item : Dynamic_String_Data_Item) return Natural;

This function returns current maximal number of characters.

function Get_Value (Item : Dynamic_String_Data_Item) return String;

This function returns the current value.

procedure Set_Maximum_Size
          (  Item : in out Dynamic_String_Data_Item;
             Size : Positive
          );

This procedure changes the maximum string size. The internally allocated string buffer is expanded if necessary.

Additionally the package declares:

function Get
         (  Data       : Stream_Element_Array;
            Pointer    : access Stream_Element_Offset;
            Terminator : Character
         )  return String;

This function gets string value from Data starting at Data (Pointer). Pointer is advanced beyond the input value. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when no terminator was detected.

procedure Put
          (  Data       : in out Stream_Element_Array;
             Pointer    : in out Stream_Element_Offset;
             Value      : String;
             Terminator : Character
          );

This procedure puts a value into Data starting at Data (Pointer). Pointer is advanced beyond the input value. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there is no room for output. Data_Error is propagated when string contains the terminator.

[Back][TOC][Next]

17.7. Variable-length strings

The package GNAT.Sockets.Connection_State_Machine.Variable_Length_Strings provides implementation of items containing variable-length strings. The package declares the data item type:

type String_Data_Item (Size : Positive) is new Data_Item with record
   Last  : Natural := 0;
   Value : String (1..Size);
end record
;

The discriminant Size is the maximum string length. The implementation of Feed propagates Data_Error when the string length exceeds the limit. The actual string value contained by the data item is Item.Value (1..Item.Last).

Additionally the package declares:

procedure Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : out String
          );

This procedure gets string value from Data starting at Data (Pointer). Pointer is advanced beyond the input value. Note that the input string length must be known in advance. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there not enough data.

procedure Put
          (  Data       : in out Stream_Element_Array;
             Pointer    : in out Stream_Element_Offset;
             Value      : String
          );

This procedure puts string into Data starting at Data (Pointer). Pointer is advanced beyond the input value. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there is no room for output.

[Back][TOC][Next]

17.8. Variable-length arrays

The package GNAT.Sockets.Connection_State_Machine.Variable_Length_Arrays provides implementation of items containing variable-length arrays. The package declares the data item type:

type Array_Data_Item (Size : Stream_Element_Count) is new Data_Item with record
   Last  : Stream_Element_Offset := 0;
   Value : Stream_Element_Array (1..Size);
end record
;

The discriminant Size is the maximum string length. The implementation of Feed propagates Data_Error when the string length exceeds the limit. The actual array value contained by the data item is Item.Value (1..Item.Last).

Additionally the package declares:

procedure Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : out Stream_Element_Array
          );

This procedure gets arrays value from Data starting at Data (Pointer). Pointer is advanced beyond the input value. Note that the input array length must be known in advance. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there not enough data.

procedure Put
          (  Data       : in out Stream_Element_Array;
             Pointer    : in out Stream_Element_Offset;
             Value      : Stream_Element_Array
          );

This procedure puts array into Data starting at Data (Pointer). Pointer is advanced beyond the input value. Layout_Error is propagated when Pointer is out of the range Data'First..Data'Last+1. End_Error is propagated when there is no room for output.

[Back][TOC][Next]

17.9. Expected sequence

The package GNAT.Sockets.Connection_State_Machine.Expected_Sequence provides implementation of items containing a fixed sequence of stream elements expected from the client. When the client sends a sequence deviating from it, Data_Error is propagated from Feed. The data item type is:

type Expected_Item (Size : Stream_Element_Count) is new Data_Item with record
   Value : Stream_Element_Array (1..Size);
end record
;

The discriminant Size is the maximum string length. Item.Value (1..Item.Last) is the expected sequence.

[Back][TOC][Next]

17.10. Server with a pool of worker tasks

The package GNAT.Sockets.Server.Pooled provides an implementation of multiple connections server backed by a pool of worker tasks. The package declares the server's type:

type Pooled_Server
     (  Factory   : access Connections_Factory'Class;
        Port      : Port_Type;
        Pool_Size : Positive
     )  is abstract new Connections_Server with private;

The discriminants are

The server queues received data to a worker task from the pool. Thus the procedures Received (and Process_Packet) are performed by the worker tasks, while the server's task does only raw I/O. A worker task is not permanently assigned to a connection. A connection can migrate from one worker task to another. Note that Pooled_Server and Connections_Server are fully compatible with regard of connection objects, which can be used with both.

procedure Disconnected
          (  Listener : in out Pooled_Server;
             Client   : in out Connection'Class
          );

This procedure is called to notify the server Listener that the client is being disconnected. It overrides the implementation of parent type (see Disconnected).

procedure Finalize (Listener : in out Pooled_Server);

This procedure is called upon object destruction. It closes all active connections and frees all other resources. When the derived type overrides this procedure it shall call it from its implementation.

procedure Initialize (Listener : in out Pooled_Server);

This procedure is called upon object construction. When the derived type overrides this procedure it shall call it from its implementation.

procedure On_Pooled_Server_Start (Listener : in out Pooled_Server);

This procedure is called when the server task starts. The default implementation does nothing.

[Back][TOC][Next]

17.11. HTTP server protocol implementation

The package GNAT.Sockets.Connection_State_Machine.HTTP_Server provides an implementation of HTTP 1.1 server protocol suitable for working with a multiple connections server, e.g. with a single task handling multiple connections. It can also be used with a server backed by a pool of tasks. The implementation does not allocate memory dynamically otherwise than for request headers and can be used for applications working under memory constraint. The package declares the HTTP connection object type:

type HTTP_Client
     (  Listener       : access Connections_Server'Class;
        Request_Length : Positive;
        Input_Size     : Buffer_Length;
        Output_Size    : Buffer_Length
     )  is new State_Machine with private;

The discriminants are

Other types declared in the package:

type HTTP_Method is
     (  HTTP_GET,
        HTTP_HEAD,
        HTTP_POST,
        HTTP_PUT,
        HTTP_DELETE,
        HTTP_TRACE,
        HTTP_OPTIONS,
        HTTP_CONNECT,
        HTTP_PATCH
     );

This type defines methods of HTTP requests.

type Connection_Flags is mod 2**3;
Connection_Close      : Connection_Flags := 1;
Connection_Persistent : Connection_Flags := 2;
Connection_Upgrade    : Connection_Flags := 4;

This type defines values of the Connection header.

type HTTP_Allowed is array (HTTP_Method) of Boolean;

This type lists the methods of HTTP requests.

type HTTP_Version is delta 0.1 digits 6 range 1.0..1_000.0;

This type is used to denote HTTP request version.

type Range_Type is (Explicit_Range, Suffix_Range);

This type defines the range type:

package Content_Ranges is
   new
Generic_Discrete_Set (Stream_Element_Count);

This is an instantiation of the package Generic_Discrete_Set which provides sets of content ranges indexed by Stream_Element_Count. The first item of content has the index 0.

type Ranges_Set (Kind : Range_Type := Explicit_Range) is record
  
Set : Content_Ranges.Set;
   case
Kind is
      when
Explicit_Range =>
         null
;
      when
Suffix_Range =>
         Tail : Stream_Element_Offset;
   end case
;
end record
;

This type a set content ranges. It may contain any number of definite ranges and up to one suffix range.

type Status_Line_Type is (None, File, URI);

This type defines the status line format:

type Status_Line
     (  Kind         : Status_Line_Type;
        Path_Length  : Natural;
        Host_Length  : Natural;
        Query_Length : Natural
     )  is
record
   Query : String (1..Query_Length);
   case Kind is
      when
None =>
         null;
      when File =>
         File : String (1..Path_Length);
      when URI =>
         Scheme : Scheme_Type;
         Host   : String (1..Host_Length);
         Port   : Port_Type;
         Path   : String (1..Path_Length);
   end case;
end record;

Values of this type are used to store request's status line. The type Scheme_Type specified supported URI schemes (see RFC 3986):

type Scheme_Type is
     (  ...
        HTTP_Scheme,
        HTTPS_Scheme,
        ...
        WS_Scheme,
        WSS_Scheme,
        ...
     );
function
Image (Scheme : Scheme_Type) return String;

This function returns name of Scheme.

A URI like:

http :// tools.ietf.org : 80 / html/rfc3986 ? section-3.2.2
                           
      Host         Path   Query
Scheme Port      

is parsed as follows:

17.11.1. Common operations

function Get_Allowed (Client : HTTP_Client) return HTTP_Allowed;

This function returns the list of methods supported by the server. The list is used to build the default response to the OPTIONS method.

function Get_Name (Client : HTTP_Client) return String;

This function returns the official server name. Usually it is overridden to return something like "my_server/1.3".

procedure Initialize (Client : in out HTTP_Client);

This procedure shall be called from the new implementation of when overridden.

procedure Received
          (  Client  : in out HTTP_Client;
             Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset
          );

This procedure overrides the standard implementation of Received.

procedure Set_Allowed
          (  Client  : in out HTTP_Client;
             Allowed : HTTP_Allowed
          );

This procedure sets the list of methods supported by the server. The list is used to build the default response to the OPTIONS method.

procedure Trace
          (  Client  : in out HTTP_Client;
             Message : String
          );

This procedure writes Message into the trace provided by the server object indicated by Client.Listener.

17.11.2. Method callbacks

The following procedures are called in response to the corresponding method, e.g. GET:

procedure Do_Connect   (Client : in out HTTP_Client);
procedure Do_Delete    (Client : in out HTTP_Client);
procedure Do_Get       (Client : in out HTTP_Client);
procedure Do_Head      (Client : in out HTTP_Client);
procedure Do_Options   (Client : in out HTTP_Client);
procedure Do_Patch     (Client : in out HTTP_Client);
procedure Do_Post      (Client : in out HTTP_Client);
procedure Do_Put       (Client : in out HTTP_Client);
procedure Do_Trace     (Client : in out HTTP_Client);
procedure Do_WebSocket (Client : in out HTTP_Client);

The implementation should send a response to the client. The default implementations of all methods except for GET, HEAD, OPTIONS respond with 501 Not implemented. OPTIONS is responded with the list set using Set_Allowed. GET is responded with 200 OK and Not implemented as the content. HEAD is responded with 200 OK.

The following code snippet illustrates implementation of Do_Get:

procedure Do_Get (Client : in out My_Client) is
   Status : Status_Line renames Get_Status_Line (Client);
begin
   case
Status.Kind is
      when
None =>
         ...
      when File =>
         if Status.File = "hello.htm" then
            Send_Status_Line (Client, 200, "OK");     -- Response status line
            Send_Date   (Client);                     -- Date header line
            Send_Server (Client);                     -- Server name
            Send_Content_Type (Client, "text/html");  -- Content type
            Accumulate_Body (Client, "<html><body>"); -- Begin content construction
            Accumulate_Body (Client, "<p>Hello world!</p>");
            Accumulate_Body (Client, "</body></html>");
            Send_Body (Client, Get);                  -- Evaluate total length, send length,
         elsif Status.File =                          -- then initiate sending the content
            ...
         end if;
      when URI =>
         ...
   end case;
end Do_Get;

17.11.3. Request header fields

The header fields of the pending request are accumulated in the arena pool of the connection object and can be queried using the following operations:

function Get_Closing (Client : HTTP_Client) return Boolean;

This function returns true the connection will be closed as soon as the last data are sent to the client.

function Get_Date (Client : HTTP_Client) return Time;

This function returns the value specified by the header Date field. Time_Error is propagated when the request has no this field specified.

function Get_Header
         (  Client : HTTP_Client;
            Header : Text_Header
         )  return String;

This function returns the value specified by the header field indicated by the parameter Header. Empty string is returned when the request has no this field specified.

function Get_If_Modified_Since (Client : HTTP_Client) return Time;

This function returns the value specified by the header If-Modified-Since field. Time_Error is propagated when the request has no this field specified.

function Get_If_Unmodified_Since (Client : HTTP_Client) return Time;

This function returns the value specified by the header If-Unmodified-Since field. Time_Error is propagated when the request has no this field specified.

function Get_Last_Modified (Client : HTTP_Client) return Time;

This function returns the value specified by the header Last-Modified field. Time_Error is propagated when the request has no this field specified.

function Get_Method (Client : HTTP_Client) return HTTP_Method;

This function returns the request's method.

function Get_Ranges (Client : HTTP_Client) return Ranges_Set;

This function returns the value of the header Range field. The result has the type Ranges_Set.

function Get_Status_Line (Client : HTTP_Client) return Status_Line;

This function returns the status line of the request. The fields of the status line are converted from escaped format to plain 8-bit strings.

function Get_Version (Client : HTTP_Client) return HTTP_Version;

This function returns HTTP version specified by the request, e.g. 1.1.

17.11.4. Receiving request bodies

The body of a request is potentially very large. Therefore differently to the request's header fields being cached, the server does not cache the body. Instead of that it uses an object provided by the user which accepts the body or several bodies in the case of a multipart content. For each body a primitive operation is called from which the server initiates body receipt:

procedure Do_Body (Client : in out HTTP_Client);

This procedure is called before the server starts receiving of the body of the pending request. The implementation, for instance, may create a file to write the body into here. It may use the information from the header fields and from the header of the body part for multipart content. The default implementation of this operation does nothing, which has the effect that the body is received but ignored. For multipart bodies Do_Body is called for each part.

function Get_Multipart_Header
         (  Client : HTTP_Client;
            Header : Multipart_Header
         )  return String;

This function can be used in Do_Body to determine the header fields of the body part. Multipart bodies are those with the content type specified as

Content-Type: multipart/form-data

Each part of the body may have header fields describing the content. These are queried using Get_Multipart_Header.

procedure Receive_Body_Tracing
          (  Client : in out HTTP_Client;
             Enable : Boolean
          );

This procedure is called to enable or disable tracing of received bodies. When enabled the server traces parts of the received bodies as it decodes them.

procedure Receive_Header_Tracing
          (  Client : in out HTTP_Client;
             Enable : Boolean
          );

This procedure is called to enable or disable tracing of received headers. When enabled the server traces parts of the received headers and multipart headers.

Stream body receiver. A body can be written into a stream. The body receipt is started by calling Receive_Body from Do_Body. As the server receives parts of the body it writes them into the stream. The process is completed by either a call to Body_Received or to Body_Error. Note that on communication errors, neither is called so that the side effects of Do_Body, e.g. open files, must be removed upon finalization of the connection object (HTTP_Client).

procedure Body_Error
          (  Client : in out HTTP_Client;
             Stream : in out Root_Stream_Type'Class;
             Error  : Exception_Occurrence
          );

This procedure is called on an error occurred during writing the request's body into the Stream. If the implementation does not propagate exceptions the rest of the body is accepted but ignored. The default implementation raises Data_Error exception.

procedure Body_Received
          (  Client : in out HTTP_Client;
             Stream : in out Root_Stream_Type'Class
          );

This procedure is called when all body is received. The default implementation does nothing. Typically when the stream is attached to a file, that file is closed in Body_Received or Body_Error.

procedure Receive_Body
          (  Client : in out HTTP_Client;
             Stream : access Root_Stream_Type'Class
          );

This procedure is called from Do_Body in order to start its receipt into Stream. The stream object specified in the call shall exist at least until a call to either Body_Received or Body_Error.

Custom body receiver. A body can be received using a descendant of the abstract type declared in the package:

type Content_Destination is abstract
   new
Ada.Finalization.Limited_Controlled
      with null record;

The following primitive operations are defined:

procedure Commit (Source : in out Content_Destination);

This procedure is when the body has been successfully received. The default implementation does nothing.

procedure Put
          (  Source : in out Content_Destination;
             Data   : String
          )  is abstract;

This procedure is called to store segments of the received body. The body receipt is started by calling Receive_Body from Do_Body. It ends by calling either to Body_Received or to Body_Error unless a communication error occurs. In the latter case the finalization of HTTP_Client should perform necessary cleanup.

procedure Body_Error
          (  Client  : in out HTTP_Client;
             Content : in out Content_Destination'Class;
             Error   : Exception_Occurrence
          );

This procedure is called when Put propagates an exception. If the implementation does not propagate exceptions the rest of the body is accepted but ignored. The default implementation raises Data_Error exception.

procedure Body_Received
          (  Client  : in out HTTP_Client;
             Content : in out Content_Destination'Class
          );

This procedure is called when all body is received. The default implementation does nothing.

procedure Receive_Body
          (  Client  : in out HTTP_Client;
             Content : in out Content_Destination'Class
          );

This procedure is called from Do_Body in order to start its receipt into Content. The object passed to the call shall exist at least until a call to either Body_Received or  Body_Error.

CGI bodies. The package provides support for CGI (Common Gateway Interface) forms posted using

Content-Type: application/x-www-form-urlencoded

which is the default. For example when the page contains forms like:

<form action="input.htm" method="post">
   <input type="text" name="text">
   <input type="submit" name="submit" value="Save">
</form>

The request's body posted by such a form consists of pairs key/value. In the above example it would be text/<some-user-input-text> and submit/save. Such bodies can be received and parsed using a Receive_Body that takes as an argument a table or a list of expected keys.

type String_Ptr is access all String;
package CGI_Keys is new Tables (String_Ptr);

The package CGI_Keys provides tables to keep key/value pairs. The key is the table token. The table maps key tokens to pointers to the string containing the corresponding value. The values are allocated in the dynamic memory of the connection object. The memory used by the values is automatically reclaimed with each new request. The following operations are provided:

procedure Body_Error
          (  Client  : in out HTTP_Client;
             Content : in out CGI_Keys.Table'Class;
             Error   : Exception_Occurrence
          );

This procedure is called on body parsing errors. If the implementation does not propagate exceptions the rest of the body is accepted but ignored. The default implementation raises Data_Error exception.

procedure Body_Received
          (  Client  : in out HTTP_Client;
             Content : in out CGI_Keys.Table'Class
          );

This procedure is called when all body is received. The implementation may use Get_CGI_Value in order to determine which keys were assigned to which values.

function Get_CGI_Key
         (  Client : HTTP_Client;
            Index  : Positive
         )  return String;

This function returns the key by its position. The keys are enumerated from 1 to Get_CGI_Size. Constraint_Error is propagated when Index in not in the range 1..Get_CGI_Size.

function Get_CGI_Size (Client : HTTP_Client) return Natural;

This function returns the number of acceptable keys. The keys are sets through a call for Receive_Body.

function Get_CGI_Value
         (  Client : HTTP_Client;
            Key    : String
         )  return String;

This function returns the value corresponding to the key specified by the parameter Key. When there is no such key or else no value was supplied the result is an empty string.

function Get_CGI_Value
         (  Client : HTTP_Client;
            Index  : Positive
         )  return String;

This function returns the value of a key by its position. The keys are enumerated from 1 to Get_CGI_Size. Constraint_Error is propagated when Index in not in the range 1..Get_CGI_Size. When no value for the key was supplied, the result is an empty string.

procedure Receive_Body
          (  Client  : in out HTTP_Client;
             Content : access CGI_Keys.Table'Class
          );

This procedure is called from Do_Body in order to start its receipt into Content. The parameter Content is either a table of keys or a string. When a table is passed, the object shall exist at least until a call to either Body_Received or  Body_Error. Note that key values are stored into the table object. Old values are erased before body receipt starts. The length of a key and a value is limited by the length of the request line specified by the discriminant Request_Length of Client. Only values of the keys present in Content are stored. Other values are ignored. When a key appears twice in the body only the first value is stored. All consequent appearances are ignored. Thus the maximum amount of memory needed to receive a body is limited by Content.

procedure Receive_Body
          (  Client    : in out HTTP_Client;
             Content   : String;
             Delimiter : Character := ','
          );

This variant specifies keys using a string. The parameter Content lists expected keys. The keys in the string are separated using the character Delimiter.

procedure Receive_Body (Client : in out HTTP_Client);

This variant allows any key for which the primitive operation Validate_Key returns true. Note that this behavior is potentially unsafe against attacks because the memory for each key/value pair is allocated dynamically. If this variant is used the default implementation of Validate_Key should be overridden in order to limit the memory use.

function Validate_Key
         (  Client : HTTP_Client;
            Key    : String
         )  return Boolean;

This function is called when Receive_Body is used in order to validate a Key. When true is returned the value corresponding to the key is stored. Otherwise the key/value pair is discarded. The default implementation accepts all keys, which is potentially unsafe.

17.11.5. Sending short responses

The following procedures are used to send short responses, usually indicating errors:

procedure Reply_HTML
          (  Client  : in out HTTP_Client;
             Code    : Positive;
             Reason  : String;
             Message : String;
             Get     : Boolean := True
          );

This procedure sends a response with HTML content. The response has the format:

HTTP/1.1 <Code> <Reason>
Date: <Clock>
Content-Type: text/html
Connection: close
Content-Length: <Message'Length>

<Message>

The response shall fit into the output buffer. Otherwise Data_Error is propagated. When Get is false, the response will not contain body, e.g. a response to a HEAD request.

procedure Reply_Text
          (  Client  : in out HTTP_Client;
             Code    : Positive;
             Reason  : String;
             Message : String;
             Get     : Boolean := True
          );

This procedure sends a response with plain text content. The response has the format:

HTTP/1.1 <Code> <Reason>
Date: <Clock>
Content-Type: text/plain
Connection: close
Content-Length: <Message'Length>

<Message>

The response shall fit into the output buffer. Otherwise Data_Error is propagated.

17.11.6. Sending response header fields

The following operations are used for sending the response header. The response should fit into the output buffer, otherwise the procedures propagate Data_Error. It is started with:

procedure Send_Status_Line
          (  Client  : in out HTTP_Client;
             Code    : Positive;
             Text    : String;
             Version : String := "HTTP/1.1"
          );

This procedure sends the status line with the code, reason text and protocol version, e.g.

HTTP/1.1 200 OK

Following the status line the response headers follow sent using the following operations:

procedure Send_Accept_Ranges
          (  Client        : in out HTTP_Client;
             Accept_Ranges : Boolean
          );

This procedure sends the Accept-Ranges header field with bytes when Accept_Ranges is true. or none, otherwise.

procedure Send_Age
          (  Client : in out HTTP_Client;
             Age    : Duration
          );

This procedure sends the Age header with the value specified by the parameter Age.

procedure Send_Allow
          (  Client  : in out HTTP_Client;
             Allowed : HTTP_Allowed
          );

This procedure sends the Allow header with the list of methods specified by the parameter Allowed.

procedure Send_Connection
          (  Client     : in out HTTP_Client;
             Persistent : Boolean := True
          );

This procedure sends the Connection header with the value keep-alive when Persistent is true or close, otherwise.

procedure Send_Connection
          (  Client     : in out HTTP_Client;
             Persistent : Boolean := True
          );

This procedure sends the Connection header with the value keep-alive when Persistent is true or close, otherwise.

procedure Send_Content_Range
          (  Client        : in out HTTP_Client;
             Content_Range : String := "none"
          );

This procedure sends the Content-Range header with the value of the parameter Content_Range.

procedure Send_Content_Range
          (  Client : in out HTTP_Client;
             From   : Stream_Element_Count;
             To     : Stream_Element_Count;
             Length : Stream_Element_Count
          );

This procedure sends the Content-Range header as From..To range followed by the total content length. For example when From=10, To=300, Length=2300 the result is:

Content-Range: 10-300/2300

procedure Send_Content_Type
          (  Client  : in out HTTP_Client;
             Media   : String := "text/plain";
             Charset : String := "UTF-8"
          );

This procedure sends the Content-Type header.

procedure Send_Date
          (  Client : in out HTTP_Client;
             Date   : Time := Clock
          );

This procedure sends the Date header with the value set from the parameter Date.

procedure Send_If_Modified_Since
          (  Client : in out HTTP_Client;
             Date   : Time
          );

This procedure sends the If-Modified-Since header with the value set from the parameter Date.

procedure Send_If_Unmodified_Since
          (  Client : in out HTTP_Client;
             Date   : Time
          );

This procedure sends the If-Unmodified-Since header with the value set from the parameter Date.

procedure Send_Last_Modified
          (  Client : in out HTTP_Client;
             Date   : Time
          );

This procedure sends the Last-Modified header with the value set from the parameter Date.

procedure Send_Length
          (  Client : in out HTTP_Client;
             Length : Natural
          );
procedure
Send_Length
          (  Client : in out HTTP_Client;
             Length : Stream_Element_Count
          );

This procedure sends the Content-Length header with the value set from the parameter Length.

procedure Send_Server (Client : in out HTTP_Client);

This procedure sends the Server header with the value obtained through a dispatching call to Get_Name.

procedure Send
          (  Client  : in out HTTP_Client;
             Message : String
          );

This procedure sends a short message, usually as a part of header response. The message shall fit into the output buffer.

17.11.7. Sending response bodies

A body can be taken from a stream, from a user-provided generator object, from the client's memory:

Short bodies.

procedure Send_Body
          (  Client  : in out HTTP_Client;
             Content : String;
             Get     : Boolean := True
          );

When the body is short, this procedure can be used to sent it. The parameter Content specifies the body to send. The output buffer should be large enough to hold the body and the Content-Length header which precedes it. Otherwise Data_Error is propagated. The parameter Get set to false for responses to a HEAD request, in which case no body is sent.

Stream contents. To send a stream content as a body, one the following procedures is called:

procedure Send_Body
          (  Client : in out HTTP_Client;
             Stream : access Root_Stream_Type'Class;
             Get    : Boolean := True
          );
procedure Send_Body
          (  Client : in out HTTP_Client;
             Stream : access Root_Stream_Type'Class;
             Length : Stream_Element_Count;
             Get    : Boolean := True
          );

The first variant uses chunked transfer, sending response header field Transfer-Encoding with the value chunked. Before it starts transferring the body. This variant is used when the content length is unknown in advance. The second variant is used when the length is known. It sends Content-Length before sending the body. The object specified by the parameter Stream shall exist until transfer completion, i.e. until Body_Sent is called, when the parameter Get is true. When the parameter Get is set to false, no body is sent. It is used when the response sent for a HEAD request.

procedure Body_Sent
          (  Client : in out HTTP_Client;
             Stream : in out Root_Stream_Type'Class
             Get    : Boolean
          );

This procedure is called when body was successfully sent. The default implementation does nothing. The implementation may close the streamed file. Note that on errors of reading the stream or sending the content the connection is dropped. Finalization of HTTP_Client should perform necessary cleanup in this case.

The following sample code illustrates a response that sends a file back using Ada.Streams.Stream_IO:

Open (File, In_File, "my_file.txt");
Send_Status_Line (Client, 200, "OK", "HTTP/1.1");
Send_Date (Client);
Send_Server (Client);
Send_Content_Type (Client, "text/plain");
Send_Body (Client, Stream (File), Stream_Element_Count (Size (File)));

Note that File must be closed later, e.g. from the implementation of Body_Sent. Send_Body only initiates file transfer, which the connection state machine takes care of.

Custom body provider. A body can be obtained from an object which type is derived from the type:

Content_Not_Ready : exception;

type Content_Source is
   abstract new
Ada.Finalization.Limited_Controlled with null record;

The following primitive operation shall be defined:

function Get (Source : access Content_Source)
   return String is abstract;

This function is called to obtain next chunk of body. The length of returned piece should not exceed the capacity of the output buffer including prefix and suffix used for chunked transfer. The body end is indicated by Get returning an empty string. Note that Get shall not block, because this will block the server. If the content is not yet ready Get may propagate Content_Not_Ready. In this case Get will be called again when the server returns back to the socket some time later.

procedure Send_Body
          (  Client  : in out HTTP_Client;
             Content : access Content_Source'Class;
             Get     : Boolean := True
          );
procedure Send_Body
          (  Client  : in out HTTP_Client;
             Content : access Content_Source'Class;
             Length  : Stream_Element_Count;
             Get     : Boolean := True
          );

The first variant uses chunked transfer, sending response header field Transfer-Encoding with the value chunked. Before it starts transferring the body. This variant is used when the content length is unknown in advance. The second variant is used when the length is known. It sends Content-Length before sending the body. The object specified by the parameter Content shall exist until transfer completion. When the parameter Get is set to false, no body is sent. It is used when the response sent for a HEAD request.

Content_Not_Ready : exception;

This is an exception Get may propagate to indicate that the content is not ready yet, but may become available in the future.

Accumulated body. A body can be built in the dynamic memory of the connection object and then sent. The following operations are used to build the body:

procedure Accumulate_Body
          (  Client  : in out HTTP_Client;
             Content : Stream_Element_Array
          );
procedure Accumulate_Body
          (  Client  : in out HTTP_Client;
             Content : String
          );

These procedures add Content to the accumulated body. The memory allocated for the body is automatically reclaimed when the next request is received.

procedure Accumulate_Body
          (  Client  : in out HTTP_Client;
             Content : access Stream_Element_Array
          );
procedure Accumulate_Body
          (  Client  : in out HTTP_Client;
             Content : access String
          );

These procedures add a reference to Content to the accumulated body. The target shall exist at least until the response is sent. Usually this variant is used for statically allocated arrays.

function Accumulated_Body_Length (Client : HTTP_Client)
   return Stream_Element_Count;

This function returns the number of stream elements of the accumulated body.

procedure Send_Body
          (  Client : in out HTTP_Client;
             Get    : Boolean := True
          );

This procedure sends the accumulated body. When the parameter Get is set to false, no body is sent. It is used when the response sent for a HEAD request.

17.11.8. WebSockets

WebSockets is an upgrade protocol for HTTP defined in RFC 6455. WebSockets allow full-duplex exchange of messages between the HTTP server and its client. Regardless its name it has little to do with network sockets. Here is a short summary of WebSockets:

A WebSocket connection in HTTP_Client is opened at the client's request which causes the function WebSocket_Open called. When the implementation of WebSocket_Open decides to accept the request, the procedure WebSocket_Initialize is called before messages exchange starts. After this for each incoming message from the client the procedure WebSocket_Received is called. The server uses the procedure WebSocket_Send to send messages to the client. The connection can be closed by the server by calling WebSocket_Close. Or it can be closed at the client request, in which case the procedure WebSocket_Closed is called. On errors WebSocket_Error is called before closing the connection. Thus upon closing the connection either WebSocket_Closed or WebSocket_Error is called. Finally the procedure WebSocket_Finalize is called, which is the last operation performed on a connection.

A connection object can be reused to run the protocol it implements over WebSocket, see HTTP_WebSocket_Client for further information.

Here is the list of WebSocket operations defined on HTTP_Client:

procedure WebSocket_Close
          (  Client  : in out HTTP_Client;
             Status  : WebSocket_Status := WebSocket_Normal_Closure;
             Message : String := ""
          );

This procedure is called when the server decides to close the current WebSocket connection. The parameter Status is the status code sent to the client. Message is the reason text. It is UTF-8 encoded. Constraint_Error is propagated when Message is longer than 123 octets. End_Error is propagated when the connection is already closed. Note that when the client requests connection close, the server need not to call to WebSocket_Close from the WebSocket_Closed notification.

procedure WebSocket_Closed
          (  Client  : in out HTTP_Client;
             Status  : WebSocket_Status;
             Message : String
          );

This procedure is called when the client closes the connection. The parameter Status is the status code received from the client and Message is the UTF-8 encoded reason text. The default implementation of this procedure does nothing.

procedure WebSocket_Error
          (  Client : in out HTTP_Client;
             Error  : Exception_Occurrence
          );

This procedure is called on errors which lead to connection closing. The parameter Error describes the error. The default implementation of this procedure does nothing.

procedure WebSocket_Finalize (Client : in out HTTP_Client);

This is the last procedure called on connection closing. The default implementation of this procedure does nothing.

procedure WebSocket_Initialize (Client : in out HTTP_Client);

This is the first procedure called after WebSocket_Open when the connection is established. The default implementation of this procedure does nothing.

function WebSocket_Open
         (  Client : access HTTP_Client
         )  return WebSocket_Accept;

This function is called when the client requests a WebSocket connection. The implementation should verify the header fields and the URI in order to decide to accept or reject the request. Custom initialization of the WebSocket exchange should happen later in the implementation of WebSocket_Initialize. The purpose of WebSocket_Open is only to decide if the connection request is to be accepted or rejected. The result's type is:

type WebSocket_Accept
     (  Accepted : Boolean;
        Length   : Natural
     )  is
record
   case
Accepted is
      when
True =>
         Size      : WebSocket_Message_Size;
         Duplex    : Boolean;
         Chunked   : Boolean;
         Protocols : String (1..Length);
      when False =>
         Code      : Positive;
         Reason    : String (1..Length);
   end case;
end record;

The discriminant Accepted specifies if the server accepts the connection request. When true, the connection is accepted and further record members specify:

When Accepted is set to false the connection is rejected and record members are:

The value of the field Duplex enables or disables full-duplex messages exchange:

The default implementation of WebSocket_Open rejects all incoming connections.

procedure WebSocket_Received
          (  Client  : in out HTTP_Client;
             Message : Stream_Element_Array
          );
procedure
WebSocket_Received
          (  Client  : in out HTTP_Client;
             Message : String
          );

These procedures are called on a message receipt. The parameter Message is the message body. It is a Stream_Element_Array if the client has sent a binary message or else a String (UTF-8 encoded) if the message was a text message. Note that Message is not checked for being a correctly encoded UTF-8 text. The default implementations do nothing.

procedure WebSocket_Received_Part
          (  Client  : in out HTTP_Client;
             Message : Stream_Element_Array
          );
procedure
WebSocket_Received_Part
          (  Client  : in out HTTP_Client;
             Message : String
          );

These procedures are called when a message part is received. It is used only when WebSocket_Open returns the Chunked field of WebSocket_Accept true and the message payload data exceeds the message buffer (the field Size). In this case the message may be delivered in chunks. Each time the message payload data buffer becomes full WebSocket_Received_Part is called. WebSocket_Received is called for the last message part indicating that the receipt is completed. The parameter Message is the message body. It is a Stream_Element_Array if the client has sent a binary message or else a String (UTF-8 encoded) if the message was a text message. Note that Message is not checked for being a correctly encoded UTF-8 text. The default implementations do nothing.

procedure WebSocket_Send
          (  Client  : in out HTTP_Client;
             Message : Stream_Element_Array
          );
procedure
WebSocket_Send
          (  Client  : in out HTTP_Client;
             Message : String
          );

These procedures send a message to the client. The parameter Message is the message body. It is a Stream_Element_Array when a binary message must be sent or else a String (UTF-8 encoded) if the message is a text message. Note that WebSocket_Send does not check validity of UTF-8 encoding. End_Error is propagated when there is no connection.

WebSocket chat sample. The following is a complete example of WebSocket based chat. We start with the package providing an implementation of the server:

File test_websocket_servers.ads:
with Ada.Exceptions;       use Ada.Exceptions;
with Ada.Streams;          use Ada.Streams;
with GNAT.Sockets;         use GNAT.Sockets;
with GNAT.Sockets.Server;  use GNAT.Sockets.Server;

with GNAT.Sockets.Connection_State_Machine.HTTP_Server;
use  GNAT.Sockets.Connection_State_Machine.HTTP_Server;

package Test_WebSocket_Servers is
   --
   -- Chat_Factory -- Creates chat connection objects
   --

   type Chat_Factory
        (  Request_Length  : Positive;
           Output_Size     : Buffer_Length;
           Max_Connections : Positive
        )  is new Connections_Factory with null record;
   function Create
            (  Factory  : access Chat_Factory;
               Listener : access Connections_Server'Class;
               From     : Sock_Addr_Type
            )  return Connection_Ptr;

The type Chat_Factory is used to create a connection instance. It is derived from Connections_Factory and overrides Create.

File test_websocket_servers.ads (continuation):
   --
   -- Chat_Client -- Chat HTTP site
   --
   type Chat_Client is new HTTP_Client with null record;
   procedure Do_Get (Client : in out Chat_Client);
   procedure Do_Head (Client : in out Chat_Client);

The type Chat_Client is an implementation of a connection to the chat server. We override Do_Get and Do_Head which will handle HTTP requests.

File test_websocket_servers.ads (continuation):
   function WebSocket_Open
            (  Client : access Chat_Client
            )  return WebSocket_Accept;
   procedure WebSocket_Received
             (  Client  : in out Chat_Client;
                Message : String
             );
end Test_WebSocket_Servers;

Next we override WebSocket_Open and WebSocket_Received, the only WebSocket operations needed.

The implementation of the package is as follows:

File test_websocket_servers.adb:
with Ada.Calendar;         use Ada.Calendar;
with Strings_Edit.Quoted;  use Strings_Edit.Quoted;

package body Test_WebSocket_Servers is

   CRLF : constant String := Character'Val (13) & Character'Val (10);
   Page : constant String :=
      "<!DOCTYPE html>" & CRLF &
      "<html lang=""en"">" & CRLF &
      "<head>" & CRLF &
      "   <meta charset=""utf-8"">" & CRLF &
      "   <title>WebSockets Test</title>" & CRLF &
      "</head>" & CRLF &
      "<body>" & CRLF &
      "   <div id=""page-wrapper"">" & CRLF &
      "      <h1>WebSockets Test</h1>" & CRLF &
      "      <div id=""status"">Connecting...</div>" & CRLF &
      "      <ul id=""messages""></ul>" & CRLF &
      "      <form id=""message-form"" action=""#""" &
      "            method=""post"">" & CRLF &
      "         <textarea id=""message""" &
      "                   placeholder=""Write message here...""" &
      "                   required></textarea>" & CRLF &
      "         <button type=""submit"">Send Message</button>" & CRLF &
      "         <button type=""button""" &
      "                 id=""close"">Close Connection</button>" & CRLF &
      "      </form>" & CRLF &
      "   </div>" & CRLF &
      "   <script 'text/javascript'>" & CRLF &
      "      window.onload = function ()" & CRLF &
      "      {" & CRLF &
      "            // Elements on the page" & CRLF &
      "         var Form =" & CRLF &
      "             document.getElementById ('message-form');" & CRLF &
      "         var Message =" & CRLF &
      "             document.getElementById ('message');" & CRLF &
      "         var List =" & CRLF &
      "             document.getElementById ('messages');" & CRLF &
      "         var Status =" & CRLF &
      "             document.getElementById ('status');" & CRLF &
      "         var Close =" & CRLF &
      "             document.getElementById ('close');" & CRLF &
      "            // Create a new WebSocket" & CRLF &
      "         var Socket = new WebSocket ('ws://localhost');" & CRLF &
      "         Socket.onerror = function (error)" & CRLF &
      "         {  // Socket error" & CRLF &
      "            console.log ('Error: ' + error);" & CRLF &
      "         };" & CRLF &
      "         Socket.onopen = function (event)" & CRLF &
      "         {  // Opened" & CRLF &
      "            Status.innerHTML = 'Connected to: '" &
      "                             + event.currentTarget.URL;" & CRLF &
      "            Status.className = 'open';" & CRLF &
      "         };" & CRLF &
      "         Socket.onmessage = function (event)" & CRLF &
      "         {  // Incoming message" & CRLF &
      "            var message = event.data;" & CRLF &
      "            List.innerHTML +=" & CRLF &
      "               '<li class=""received""><span>Received:</span>'" &
      "              + message + '</li>';" & CRLF &
      "         };" & CRLF &
      "         Socket.onclose = function (event)" & CRLF &
      "         {  // Disconnected" & CRLF &
      "            Status.innerHTML = 'Disconnected';" & CRLF &
      "            Status.className = 'closed';" & CRLF &
      "         };" & CRLF &
      "         Form.onsubmit = function (e)" & CRLF &
      "         {  // Send when the form is submitted" & CRLF &
      "            e.preventDefault ();" & CRLF &
      "            var Text = Message.value; // Text" & CRLF &
      "            Socket.send (Text); // Send the message" & CRLF &
      "            List.innerHTML += // To the list" & CRLF &
      "               '<li class=""sent""><span>Sent:</span>'" &
      "             + Text + '</li>';" & CRLF &
      "            Message.value = ''; // Clear the field" & CRLF &
      "            return false;" & CRLF &
      "         };" & CRLF &
      "         Close.onclick = function (e)" & CRLF &
      "         {  // When the close button is clicked" & CRLF &
      "            e.preventDefault ();" & CRLF &
      "            Socket.close(); // Close the socket" & CRLF &
      "            return false;" & CRLF &
      "         };" & CRLF &
      "      };" & CRLF &
      "   </script>" & CRLF &
      "</body>" & CRLF &
      "</html>";

Page is the web page source. It contains a web-form with chat text and two buttons. The rest of the page is a JavaScript program that deals with the WebSocket at the client side. It opens a connection and then when the send button is pressed sends the text over the WebSocket to the server. The server's message is put back into the text field.

File test_websocket_servers.adb (continued):
   function Create
            (  Factory  : access Chat_Factory;
               Listener : access Connections_Server'Class;
               From     : Sock_Addr_Type
            )  return Connection_Ptr is
      Result : Connection_Ptr;
   begin
      Result :=
         new Chat_Client
             (  Listener       => Listener.all'Unchecked_Access,
                Request_Length => Factory.Request_Length,
                Output_Size    => Factory.Output_Size
             );
      Receive_Body_Tracing (Chat_Client (Result.all), True);
      return Result;
   end Create;

This function is called when a HTTP connection is requested. It creates a new connection instance (Chat_Client) and turns on tracing.

File test_websocket_servers.adb (continued):
   procedure Do_Get_Head
             (  Client : in out Chat_Client;
                Get    : Boolean
             )  is
      Status : Status_Line renames Get_Status_Line (Client);
   begin
      case
Status.Kind is
         when
None =>
            Reply_Text (Client, 404, "Not found", "Not found");
         when File =>
            if Status.File = "" or else Status.File = "index.htm" then
               Send_Status_Line (Client, 200, "OK");
               Send_Date (Client);
               Send_Server (Client);
               Send_Content_Type (Client, "text/html");
               Accumulate_Body (Client, Page);
               Send_Body (Client, Get);
            else
               Reply_Text
               (  Client,
                  404,
                  "Not found",
                  "No file " & Quote (Status.File) & " found"
               );
            end if;
         when URI =>
            Reply_Text
            (  Client,
               404,
               "Not found",
               "No URI " & Quote (Status.Path) & " found"
            );
      end case;
   end Do_Get_Head;

   procedure Do_Get (Client : in out Chat_Client) is
   begin

      Do_Get_Head (Client, True);
   end Do_Get;

   procedure Do_Head (Client : in out Chat_Client) is
   begin

      Do_Get_Head (Client, False);
   end Do_Head;

On a HTTP request like GET or HEAD when the file name is empty or else index.htm the page is sent back. The response's header contains current date, server and content fields.

File test_websocket_servers.adb (continued):
   function WebSocket_Open
            (  Client : access Chat_Client
            )  return WebSocket_Accept is
   begin
      return
(True, 0, 1024, False, "");
   end WebSocket_Open;

When a WebSocket connection is requested, it is accepted. The communication mode set to half-duplex as the server will send nothing on its own initiative.

File test_websocket_servers.adb (continued):
   procedure WebSocket_Received
             (  Client  : in out Chat_Client;
                Message : String
             )  is
   begin

      WebSocket_Send (Client, To_HTTP (Clock) & " " & Quote (Message));
   end WebSocket_Received;

end Test_WebSocket_Servers;

When a WebSocket message is received, the current time stamp with quoted message is sent back.

The main program looks like:

File test_websocket_server.adb:
with Ada.Exceptions;          use Ada.Exceptions;
with Ada.Text_IO;             use Ada.Text_IO;
with Test_WebSocket_Servers;  use Test_WebSocket_Servers;

with GNAT.Sockets.Server.Pooled;

procedure Test_WebSocket_Server is
   Minutes : constant := 3.0;
   Port    : constant := 80;
   Tasks   : constant := 5;
begin
   declare

      Factory : aliased Chat_Factory
                        (  Request_Length  => 200,
                           Output_Size     => 1024,
                           Max_Connections => 100
                        );
      Server : GNAT.Sockets.Server.
               Connections_Server (Factory'Access, Port);
   begin
      Trace_On (Factory => Factory, Received => True, Sent => True);
      Put_Line ("HTTP server started");
      delay 60.0 * Minutes; -- Service
      Put_Line ("HTTP server stopping");
   end;
exception
   when Error : others =>
      Put_Line ("Error: " & Exception_Information (Error));
end Test_WebSocket_Server;

A factory object is created first. Then a pooled server is created. Once created it can be connected to from a browser that supports WebSockets. After 3 minutes the application completes.

17.11.9. Utility routines

function From_Escaped
         (  Name           : String;
            Translate_Plus : Boolean := False
         )  return String;

This function converts Name to an RFC 2396-escaped sequence. The sequence uses %HH to represent special characters. When Translate_Plus is true '+' is replaced with space.

function To_Escaped (Name : String) return String;

This function converts Name from an RFC 2396-escaped sequence to plain string.

function To_HTML (Text : String) return String;

This function encodes an UTF-8 string Text using HTML escape sequences, e.g. &#HHH;. Data_Error is propagated when Text is not a valid UTF-8 string.

function To_HTTP (Date : Time) return String;

This function returns time represented in HTTP format, e.g.

Sun, 17 Feb 2013 21:02:43 +0100

function To_Time (Date : String) return Time;

This function converts time represented in HTTP format to Ada.Calendar.Time. Time_Error is propagated on errors.

17.11.10. SQLite3 database browser

The package GNAT.Sockets.Connection_State_Machine.HTTP_Server.SQLite_Browser provides simplified means to browse a SQLite3 database on the host side. This can be used for debugging purposes. When an embedded server deploys an SQLite3 database, it is convenient to be able to view the database state remotely.

SQLite3 browsing facilities are implemented as types derived from Content_Source. The following code snippet illustrates typical usage:

DB_Root : aliased DB_Tables_Content;
...
Set_Database_Path (DB_Root, File);  -- Set database file
Send_Status_Line (Client, 200, "OK");
Send_Date (Client);
Send_Server (Client);
Send_Content_Type (Client, "text/html");
Send_Body (Client, DB_Root'Access); -- Send back the list of all
                                    -- database tables

The abstract content type used as the base for other types:

type Abstract_SQLite_Content is
   abstract new
Content_Source with private;

Here are the primitive operations of the type:

function Get_Database (Content : Abstract_SQLite_Content)
   return Data_Base;

This function returns a handle to the database object previously set using either Set_Database or Set_Database_Path.

function Get_Database_Path (Content : Abstract_SQLite_Content)
   return String;

This function returns the database file path as previously set using either Set_Database or Set_Database_Path. When no database set, the result is an empty string.

procedure Set_Database
          (  Content : in out Abstract_SQLite_Content;
             Source  : Abstract_SQLite_Content'Class
          );

This procedure sets the database same as the database set in Source.

procedure Set_Database
          (  Content   : in out Abstract_SQLite_Content;
             Database  : Data_Base;
             File_Name : String
          );

This variant uses a handle to the database object of an already opened database and its file name.

procedure Set_Database_Path
          (  Content   : in out Abstract_SQLite_Content;
             File_Name : String;
             Flags     : Open_Flags := READONLY or FULLMUTEX
          );

This procedure sets the database. The parameter File_Name is the path to the SQLite3 database file. Flags specifies the options used when the database file is opened. Data_Error is propagated when on a database error. Use_Error is propagated on a file open error.

type Abstract_Table_Content is
   abstract new
Abstract_SQLite_Content with private;

This type is the base type of contents related to a database table. Before first use the database should be set using either Set_Database or Set_Database_Path and Set_Table. The following primitive operations are defined:

function Get_Table (Content : Abstract_Table_Content) return String;

This function returns the name of the table previously set using the procedure Set_Table. When no table was set, the result is an empty string.

procedure Set_Table
          (  Content : in out Abstract_Table_Content;
             Table   : String
           );

This procedure sets the table to use.

procedure Set_Table
          (  Content : in out Abstract_Table_Content;
             Source  : Abstract_Table_Content'Class
           );

This procedure sets the database and the table from the object Source.

Browsing database tables.

The following content type lists the database tables:

type DB_Tables_Content is new Abstract_SQLite_Content with private;

The page is formatted as a table which contains names of the tables in its rows. The table names are linked to the pages which paths are returned by the operation Get_Content_Page. The table name is followed to a link to the page representing the table's schema. The table schema page path is returned by the operation Get_Schema_Page.

 The following primitive operations are declared on the type:

function Get_Content_Page
         (  Content : DB_Tables_Content;
            Table : String
         )  return String;

This function returns the name of the page that lists the contents of the table. The result is:

<database-path>/<table-name>/content.htm

where <database-path> is the result of Get_Database_Path and <table-name> is Table. The function can be overridden in order to provide a different naming. The server must use an instance of Table_Content object for the page.

function Get_Schema_Page
         (  Content : DB_Tables_Content;
            Table : String
         )  return String;

This function returns the name of the page that lists the contents of the table. The result is:

<database-path>/<table-name>/schema.htm

where <database-path> is the result of Get_Database_Path and <table-name> is Table. The function can be overridden in order to provide a different naming. The server must use an instance of Schema_Content object for the page.

Listing database table schema.

The following content type lists the schema of a database table:

type Schema_Content is new Abstract_Table_Content with private;

The content is formatted as a table which lists information the database table's columns. I.e. the column name, data type etc. This following primitive operations are declared:

function Get_Content_Page
         (  Content : DB_Tables_Content;
            Table : String
         )  return String;

This function returns the name of the page that lists the contents of the table. The result is:

Listing database table content.

The content is formatted as a table which lists the database table's columns. The following content type lists the contents of a database table:

type Table_Content
     (  Max_String_Column_Width : Positive
     )  is new Abstract_Table_Content with private;

The discriminant Max_String_Column_Width specifies the maximal number of string or blob characters indicated before the string representation is truncated.

Querying the database.

The following content type is used to execute SQL queries on a database:

type DB_Query_Content
     (  Max_String_Column_Width : Positive
     )  is new Abstract_Table_Content with private;

The content shows a form to input the query and a button to submit the query. The submitted query is executed and the result set, if any, is listed on the page. The discriminant Max_String_Column_Width specifies the maximal number of string or blob characters indicated before the string representation is truncated. The database is set using either Set_Database or Set_Database_Path. Whether the database can be modified by query is determined by the parameter Flags used in Set_Database_Path. The following operations are defined:

function Get_Query_Action (Content : DB_Query_Content)
   return String;

The function returns the field action used for the database query. It can be overridden in order to provide a different naming. The server must use an instance of DB_Query_Content object for the action. The result is:

<database-path>/query.htm

The method of the action is POST. It means that the query must be processed within the body of Do_Post. When the field File of Get_Status_Line is Get_Query_Action the content should be used in the response:

if Get_Query_Action (Client).File = Get_Query_Action (Query) then
   Send_Status_Line (Client, 200, "OK");
   Send_Date (Client);
   Send_Server (Client);
   Send_Content_Type (Client, "text/html");
   Set_Statement (Query, Get_CGI_Value (Client, "statement"));
   Send_Body (Client, Query'Access);
   return;

The CGI key of containing the SQL command is statement.

procedure Set_Statement
          (  Content   : in out DB_Query_Content;
             Statement : String
          );

This procedure should be used in order to execute a statement and then show its result set as a part of the content. The execution happens when the content is sent using Send_Body. Typically it is set from the CGI key statement.

17.11.11. WebSocket connection handler

There are protocols defined for both TCP and WebSockets. For instance MQTT is such a protocol. The connection object implementations can be used for both without modification. When a connection object is handled by a Connections_Server the protocol implemented by the object runs over a TCP socket. For WebSocket it is a HTTP client that handles the connection object. The package GNAT.Sockets.Connection_State_Machine.HTTP_Server.WebSocket_Server provides an implementation of HTTP server capable to handle connection objects.

type HTTP_WebSocket_Client
     (  Listener       : access Connections_Server'Class;
        Request_Length : Positive;
        Input_Size     : Buffer_Length;
        Output_Size    : Buffer_Length;
        Factory        : access Connections_Factory'Class;
        Buffer_Size    : Buffer_Length
     )  is new HTTP_Client with private;

The type HTTP_WebSocket_Client is a HTTP server accepting WebSocket connections. It can be used to derive custom HTTP implementations if the server should also provide some HTTP content. When the client switches into WebSocket mode, the server asks its factory to create a connection object which then is used to handle WebSocket exchange. The discriminants Listener, Request_Length, Input_Size, Output_Size are same as in HTTP_Client. The other discriminants are:

The following primitive operations are defined:

function Get_WebSocket_Client
         (  Client : HTTP_WebSocket_Client
         )  return Handle;

This function returns a handle (from GNAT.Sockets.Server.Handles) to the current connection object running over the WebSocket. The handle is invalid when no WebSocket connection is engaged.

function Get_Error_Code
         (  Client : HTTP_WebSocket_Client
         )  return Positive;

When the factory of WebSocket connection objects refuses connection, the result of this function is used to report the error code. The default implementation returns 400.

function Get_Error_Reason
         (  Client : HTTP_WebSocket_Client
         )  return Positive;

When the factory of WebSocket connection objects refuses connection, the result of this function is used to report the reason text. The default implementation returns "Bad request".

function Get_Protocols
         (  Client : HTTP_WebSocket_Client
         )  return Positive;

When accepted the client receives a list of supported protocols as returned by this function. When the result is empty the value of Sec-WebSocket-Protocol is used instead. The default implementation returns empty string.

[Back][TOC][Next]

17.12. HTTP client protocol implementation

The package GNAT.Sockets.Connection_State_Machine.HTTP_Client provides an implementation of HTTP 1.1 client protocol suitable for working with a multiple connections server, e.g. with a single task handling multiple connections. It can also be used with a server backed by a pool of tasks. The package declares the HTTP connection object type:

type HTTP_Session
     (  Listener        : access Connections_Server'Class;
        Response_Length : Positive;
        Input_Size      : Buffer_Length;
        Output_Size     : Buffer_Length
     )  is new State_Machine with private;

The discriminants are

The implementation functions asynchronously as other connection objects on the context of the multiple connections server's task. When used from another task note that the connection might be missing or the object might be already active with a request. The object operations such as Get only initiate a request. Their completion must be awaited. The following primitive operations are provided:

procedure Connect_Parameters_Set
          (  Session        : in out HTTP_Session;
             Host           : String;
             Address        : Sock_Addr_Type;
             Max_Connect_No : Positive
          );

The procedure overrides the default implementation of Connect_Parameters_Set. It sets the Host header to Host.

procedure Connected (Session : in out HTTP_Session);

The procedure overrides the default implementation of Connected.

procedure Completed
          (  Session : in out HTTP_Session;
             Method  : HTTP_Server.HTTP_Method;
             Status  : Positive
           [ Message : access destination of the response message ]
          );

One of the procedures is called upon response message receipt. Method is the HTTP method which was used in the request. Status is the response status code. Message is the object where the message response was stored. If any, it can be of ether of the types:

The default implementation does nothing.

procedure Delete
          (  Session : in out HTTP_Session;
             Name    : String
           [ Message : access destination of the response message ]
          );

These procedures issue a request with the DELETE method. Name is the requested URI. Message, when specified, is the container to receive the response's message. It can be of ether of the types:

Use_Error is propagated when there is no connection or else another request is still pending.

procedure Get
          (  Session : in out HTTP_Session;
             Name    : String;
             Message : access destination of the response message
             From    : Stream_Element_Count := 1;
             To      : Stream_Element_Count := 0
          );

These procedures issue a request with the GET method. Name is the requested URI. Message is the container to receive the response's message. It can be of ether of the types:

From..To is the range to send as the Range header. When From is greater than To no Range header is sent. Use_Error is propagated when there is no connection or else another request is still pending.

function Get_Keep_Alive (Session : HTTP_Session) return Boolean;

This function returns true if the Connection header used in request is keep-alive. Otherwise it is close. See also Set_Keep_Alive.

function Get_Request_Header
         (  Session : HTTP_Session;
            Header  : HTTP_Server.Text_Header
         )  return String;

This function returns the value of text header used in requests. When empty string is returned the corresponding header will not be used in the requests. The request header values are set with Set_Request_Header. Some of them can be set explicitly upon method invocation, when they are required by the method.

function Get_Request_Method
         (  Session : HTTP_Session
         )  return HTTP_Server.HTTP_Method;

This function returns the method used in the last request. E.g. it is HTTP_GET after calling Get.

procedure Get_Request_Range
          (  Session : HTTP_Session;
             From    : out Stream_Element_Count;
             To      : out Stream_Element_Count
          );

This procedure uses the range (zero-based bytes of content) used in the last request. When From is greater than To, no range was used.

function Get_Response_Code (Session : HTTP_Session) return Positive;

This function returns the status code as retuned in the response to the last request. E.g. 200, 404 etc.

function Get_Response_Connection_Flags
         (  Session : HTTP_Session
         )  return HTTP_Server.Connection_Flags;

This function returns the value of the Connection header in the last response. Note that when the server returns Connection: close, the client drops the session. In that case client must explicitly reconnect to the server again, e.g. by calling Connect.

function Get_Response_Header
         (  Session : HTTP_Session;
            Header  : Text_Header
         )  return String;

This function returns the value of the header as returned in the last server response. For headers not specified in the response the result is an empty string.

function Get_Response_Reason (Session : HTTP_Session) return String;

This function returns the reason text from the last server response, e.g. "OK".

function Get_Response_Version (Session : HTTP_Session) return HTTP_Server.HTTP_Version;

This function returns the protocol version number as given in the last server response. Typically, it is 1.1.

procedure Head
          (  Session : in out HTTP_Session;
             Name    : String;
             From    : Stream_Element_Count := 1;
             To      : Stream_Element_Count := 0
          );

This procedures issues a request with the HEAD method. Name is the requested URI. From..To is the range to send as the Range header. When From is greater than To no Range header is sent. Use_Error is propagated when there is no connection or else another request is still pending.

procedure Initialize (Session : in out HTTP_Session);

This procedure must be called from the new implementation if overridden.

function Is_Active (Session : HTTP_Session) return Boolean;

This function returns true if there is a request pending on the connection.

procedure Message_Store_Error
          (  Session : in out HTTP_Session;
             Stream  : in out Root_Stream_Type'Class;
             Error   : Exception_Occurrence
          );
procedure
Message_Store_Error
          (  Session : in out HTTP_Session;
             Content : in out HTTP_Server.Content_Destination'Class;
             Error   : Exception_Occurrence
          );

One of these procedures is called on an error occurred during storing the response data. The method caused the error can be obtained using Get_Request_Method. The default implementations raise Data_Error exception which causes the connection to be dropped.

procedure Options
          (  Session : in out HTTP_Session;
             Name    : String
           [ Message : access destination of the response message ]
          );

These procedures issue a request with the OPTIONS method. Name is the requested URI. Message is the container to receive the response's message. It can be of ether of the types:

Use_Error is propagated when there is no connection or else another request is still pending.

procedure Post
          (  Session : in out HTTP_Session;
             Name    : String;
             Content : source of the request body;
           [ Length  : Stream_Element_Count; ]
             Message : access destination of the response message;
             MIME    : String := Post_MIME
          );

These procedures issue a request with the POST method. Name is the requested URI. The request body is specified by the parameter Content. It can be one of the following types:

 Message is the container to receive the response's message. It can be of ether of the types:

The parameter MIME is the value to be used with the Content-Type header. By default it is application/x-www-form-urlencoded. Use_Error is propagated when there is no connection or else another request is still pending.

procedure Put
          (  Session : in out HTTP_Session;
             Name    : String;
             Content : source of the request body;
           [ Length  : Stream_Element_Count; ]
             Message : access destination of the response message;
             MIME    : String := Post_MIME
          );

These procedures issue a request with the PUT method. Name is the requested URI. The request body is specified by the parameter Content. It can be one of the following types:

 Message is the container to receive the response's message. It can be of ether of the types:

The parameter MIME is the value to be used with the Content-Type header. By default it is text/html; charset=utf-8. Use_Error is propagated when there is no connection or else another request is still pending.

procedure Receive_Header_Tracing
          (  Session : in out HTTP_Session;
             Enable  : Boolean
          );

This procedure enables or disables response header tracing.

procedure Receive_Message_Tracing
          (  Session : in out HTTP_Session;
             Enable  : Boolean
          );

This procedure enables or disables response message tracing.

procedure Set_Keep_Alive
          (  Session : in out HTTP_Session;
             Enable  : Boolean
          );

Normally when a query is completed the client disconnects from the server. The connection object is collected. This behavior is matched by the request header Connection set to close. Alternatively the client may stay connected in which case the header is set to keep-alive. This procedure is used to change the behavior. Note that the server may request dropping connection anyway.

procedure Set_Request_Date
          (  Session : in out HTTP_Session;
             Enable  : Boolean
          );

This procedure enables or disables the header Date to be used with the requests. By default the Date header is enabled.

procedure Set_Request_Header
          (  Session : in out HTTP_Session;
             Header  : HTTP_Server.Text_Header;
             Value   : String := ""
          )  return String;

This procedure sets the value of a text header used in requests. When empty string is set the corresponding header will not be used in the requests.

procedure Set_Request_If_Modified_Since
          (  Session : in out HTTP_Session;
           [ Date    : Time ]
          );

This procedure enables or disables the header If-Modified-Since to be used with the requests. By default the header is disabled. To enable the header the parameter Date must be specified, which will be the header value. To disable the header Date must be omitted. Time_Error is propagated when Date is invalid. 

procedure Set_Request_If_Unmodified_Since
          (  Session : in out HTTP_Session;
           [ Date    : Time ]
          );

This procedure enables or disables the header If-Unmodified-Since to be used with the requests. By default the header is disabled. To enable the header the parameter Date must be specified, which will be the header value. To disable the header Date must be omitted. Time_Error is propagated when Date is invalid. 

procedure Set_Request_If_Unmodified_Since
          (  Session : in out HTTP_Session;
           [ Date    : Time ]
          );

This procedure enables or disables the header If-Unmodified-Since to be used with the requests. By default the header is disabled. To enable the header the parameter Date must be specified, which will be the header value. To disable the header Date must be omitted. Time_Error is propagated when Date is invalid. 

procedure Trace
          (  Session : in out HTTP_Session;
             Message : String
          );

This procedure is used to write trace.

17.12.1. Signaled client

The package GNAT.Sockets.Connection_State_Machine.HTTP_Client.Signaled provides a client to use with an external task. The client HTTP_Session is driven by the task of the multiple connection server. The task can service more than one socket and one connection. When operating in this mode HTTP_Session should be extended to implement higher level logic from call-backs such as Connected and Completed. A more straightforward would be non-busy waiting for a connection to be established and a pending request to complete in some independent task as implemented in this package:

type HTTP_Session_Signaled is new HTTP_Session with private;

This is the type of a client to used from an external task. Note that when created the object must be referenced using a handle in order to prevent its premature destruction (see memory management of connection objects).

The implementation functions asynchronously as other connection objects on the context of the multiple connections server's task. When used from another task note that the connection might be missing or the object might be already active with a request. The object operations such as Get only initiate a request. Their completion must be awaited. The following primitive operations are provided:

procedure Cancel (Session : in out HTTP_Session_Signaled);

The procedure cancels Connect and Wait operations pending in other tasks. The corresponding operations propagate Cancel_Error declared in this package. Note that this has no effect on the communication performed by the client.

procedure Connect
          (  Session        : in out HTTP_Session_Signaled;
             Host           : String;
             Port           : Port_Type := 80;
             Max_Connect_No : Positive  := Positive'Last;
             Timeout        : Duration  := Duration'Last
          );

The procedure is a synchronous variant of asynchronous Connect. Unlike the latter it awaits for the connection to be established. Timeout is the connection timeout. Timeout_Error, declared in this package, is propagated when the timeout expires. Cancel_Error is propagated when some other tasks calls Cancel. Note that in both cases communication with the target, e.g. connection attempts, is not interrupted or influenced.  Status_Error is propagated when the number of attempts was exhausted. Other errors, e.g. Socket_Error indicate I/O errors.

procedure Wait
          (  Session   : in out HTTP_Session_Signaled;
             Connected : Boolean;
             Timeout   : Duration := Duration'Last
          );

The procedure awaits the session to become ready for another request when Connected is true. If the connection gets lost an exception is propagated as described below. When Connected is false the procedure waits for any pending request to complete, the connection can be dropped without raising an exception.

Timeout is the connection timeout. Timeout_Error is propagated when the timeout expires. Cancel_Error is propagated when the operation was canceled by another task calling Cancel. Note that in both cases communication with the target is not interrupted or influenced. Status_Error is propagated when the number of attempts was exhausted. Other errors, e.g. Socket_Error indicate I/O errors.

[Back][TOC][Next]

17.13. MODBUS client protocol implementation

The package GNAT.Sockets.Connection_State_Machine.MODBUS_Client provides an implementation of the MODBUS TCP/IP and MODBUS RTU clients. The client is suitable for working with a multiple connections server, e.g. with a single task handling multiple connections. It can also be used with a server backed by a pool of tasks. The MODBUS RTU is typically used with a Blocking_Server or its descendant backed by a serial port RS-232 or RS-458.

The MODBUS function codes supported by the client are:

Class 0:

Class 1:

Class 2:

The package declares the MODBUS_Client connection object type:

type MODBUS_Client
     (  Listener    : access Connections_Server'Class;
        Output_Size : Buffer_Length
     )  is new State_Machine with private;

The discriminants are:

The client operations are asynchronous, normally meant to be called on the context of the multiple connections server task. For a client with synchronous operations see MODBUS_Synchronous_Client. The following types and constants are declared:

MODBUS_Port : constant Port_Type := 502;

This is the MODBUS TCP/IP port number.

type Exception_Code is new Unsigned_8;

This is the type of the exception code returned by the MODBUS master when it rejects a request.

function Error_Text (Code : Exception_Code) return String;

This function returns textual description of the exception code Code.

type Function_Code is new Unsigned_8;

This is the type of the MODBUS function code, e.g. 2 denotes FC2.

type Unit_No is new Unsigned_8;

This is the MODBUS slave number. A MODBUS server may handle up to 254 slaves. The number 255 is used when the server has only one slave, which number is irrelevant.

type Bit_Address is new Unsigned_16;

This type defines the MODBUS address space that maps coils and digital outputs. The actual mapping depends on the concrete device.

type Word_Address is new Unsigned_16;

This type defines the MODBUS address space that maps 16-bit registers. The word addresses are incremented by 1.

type Reference_ID is new Unsigned_16;

The reference value is used to identify requests. The server sends the same value back it becomes from the client.

type Bit_Array is array (Bit_Address range <>) of Boolean;

This type is used to define a set of consequent bits when sent to or received from the server.

type Word_Array is array (Word_Address range <>) of Unsigned_16;

This type is used to define a set of consequent words when sent to or received from the server.

The following primitive operations are provided for the client:

procedure Bits_Read
          (  Client    : in out MODBUS_Client;
             Reference : Reference_ID;
             Values    : Bit_Array;
             Code      : Function_Code;
             Unit      : Unit_No
          );

This procedure is called when some bits were successfully read. The read values are in set into the parameter Values. Note that the array indices do not correspond to the actual bit addresses. Reference has the value passed to the server with the request. Code is the function code 1, 2 (FC1, FC2). Unit is the slave responding if more than one. The default implementation traces.

procedure Bits_Written
          (  Client    : in out MODBUS_Client;
             Reference : Reference_ID;
             From      : Bit_Address;
             To        : Bit_Address;
             Code      : Function_Code;
             Unit      : Unit_No
          );

This procedure is called when some bits were successfully written. From..To is the written range of addresses. Reference has the value passed to the server with the request. Code is the function code 5, 15 (FC5, FC15). Unit is the slave responding if more than one. The default implementation traces.

function Can_Send
         (  Client : MODBUS_Client;
            Code   : Function_Code;
            Count  : Natural := 0
         )  return Boolean;

This function returns true if the output buffer has space to queue a request with the function code specified by Code. The parameter Count is the number of bits to write for FC15. It is the number of words to write for FC16 or FC23. For other function codes Count is ignored. Constraint_Error is propagated when the function code is not supported. Note that sending can still fail if there is no connection to the MODBUS server. See also Wait_For_RTU_Silence.

procedure Exception_Status_Received
          (  Client    : in out MODBUS_Client;
             Reference : Reference_ID;
             Status    : Unsigned_8;
             Unit      : Unit_No
          );

This procedure is called when FC7 request is completed. Status is the the exception status (a predefined range of coils). Reference has the value passed to the server with the request. Unit is the slave responding if more than one. The default implementation traces.

procedure Failed
          (  Client    : in out MODBUS_Client;
             Reference : Reference_ID;
             Error     : Exception_Code;
             Code      : Function_Code;
             Unit      : Unit_No
          );

This procedure is called when the server responds with an exception. Error is the exception code. Reference has the value passed to the server with the request. Code is the function code that caused the exception. Unit is the slave responding if more than one. The default implementation traces.

function Get_Request_Length
         (  Client : MODBUS_Client;
            Code   : Function_Code;
            Count  : Natural := 0
         )  return Stream_Element_Count;

This function returns the number of elements in the output buffer required to queue a request with the function code specified by Code. The parameter Count is the number of bits to write for FC15. It is the number of words to write for FC16 or FC23. For other function codes Count is ignored. Constraint_Error is propagated when the function code is not supported.

function Get_RTU_Checksum_Mode
         (  Client : MODBUS_Client
         )  return Boolean;

This function returns true if the client is in the MODBUS RTU mode. The protocol of MODBUS RTU significantly differs from MODBUS TCP/IP. By default the client is in the TCP/IP mode. Note that this is irrelevant to the transport layer. Both can be run over any transport. The RTU mode is set using Set_RTU_Checksum_Mode.

function Get_RTU_Silence_Time
         (  Client : MODBUS_Client
         )  return Duration;

This function returns the silence time used in the MODBUS RTU mode. The silence time is set using the procedure Set_RTU_Silence_Time. Initially the silence time is zero.

The protocol of MODBUS RTU requires a silence time between protocol packets. The client verifies that the time since last packet is no less than the silence time otherwise procedures Send_FCx propagate Data_Error. Use the procedure Wait_RTU_Silence_Time to wait for the end of silence time. The synchronous MODBUS client transparently awaits the end of silence time.

procedure Send_FC1
          (  Client    : in out MODBUS_Client;
             Reference : Reference_ID;
             From      : Bit_Address;
             To        : Bit_Address;
             Unit      : Unit_No := 255
          );

This procedure is called to send a Read Coils request. The execution is asynchronous, when completed Bits_Read is called. Upon MODBUS exceptions Failed is called. Reference is any value the server will return back, e.g. a sequence number. From..To is the bit range to read. Unit is the slave to query. Use_Error is propagated when the server is not connected. Data_Error is propagated when the output buffer is full, e.g. when the client tries to queue several requests without awaiting a response.

procedure Send_FC2
          (  Client    : in out MODBUS_Client;
             Reference : Reference_ID;
             From      : Bit_Address;
             To        : Bit_Address;
             Unit      : Unit_No := 255
          );

This procedure is called to send a Read Discrete Inputs request. The behavior and parameters are same as of Send_FC1.

procedure Send_FC3
          (  Client    : in out MODBUS_Client;
             Reference : Reference_ID;
             From      : Word_Address;
             To        : Word_Address;
             Unit      : Unit_No := 255
          );

This procedure is called to send a Read Holding Registers request. The execution is asynchronous, when completed Words_Read is called. Upon MODBUS exceptions Failed is called. Reference is any value the server will return back, e.g. a sequence number. From..To is the words range to read. Unit is the slave to query. Use_Error is propagated when the server is not connected. Data_Error is propagated when the output buffer is full, e.g. when the client tries to queue several requests without awaiting a response.

procedure Send_FC4
          (  Client    : in out MODBUS_Client;
             Reference : Reference_ID;
             From      : Word_Address;
             To        : Word_Address;
             Unit      : Unit_No := 255
          );

This procedure is called to send a Read Input Registers request. The behavior and parameters are same as of Send_FC3.

procedure Send_FC5
          (  Client    : in out MODBUS_Client;
             Reference : Reference_ID;
             Address   : Bit_Address;
             Value     : Boolean;
             Unit      : Unit_No := 255
          );

This procedure is called to send a Write Single Coil request. The behavior is same as of Send_FC15. Address is the address of coil. Value is the value to write.

procedure Send_FC6
          (  Client    : in out MODBUS_Client;
             Reference : Reference_ID;
             Address   : Word_Address;
             Value     : Unsigned_16;
             Unit      : Unit_No := 255
          );

This procedure is called to send a Write Single Holding Register request. The behavior is same as of Send_FC16. Address is the address of the register. Value is the value to write. The value is big-endian encoded when sent to the slave.

procedure Send_FC7
          (  Client    : in out MODBUS_Client;
             Reference : Reference_ID;
             Unit      : Unit_No := 255
          );

This procedure is called to send a Read Exception Status request. The execution is asynchronous, when completed Exception_Status_Received is called. Upon MODBUS exceptions Failed is called. Reference is any value the server will return back, e.g. a sequence number. Unit is the slave to query. Use_Error is propagated when the server is not connected. Data_Error is propagated when the output buffer is full, e.g. when the client tries to queue several requests without awaiting a response.

procedure Send_FC15
          (  Client    : in out MODBUS_Client;
             Reference : Reference_ID;
             Values    : Bit_Array;
             Unit      : Unit_No := 255
          );

This procedure is called to send a Write Multiple Coils request. The execution is asynchronous, when completed Bits_Written is called. Upon MODBUS exceptions Failed is called. Reference is any value the server will return back, e.g. a sequence number. Values is the bits to write. The array indices correspond to the addresses where to write the values. For example, if on, off, on has to be written at 3..5, Values must be:

(3=>True, 4=>False, 5=>True)

Unit is the slave to query. Use_Error is propagated when the server is not connected. Data_Error is propagated when the output buffer is full, e.g. when the client tries to queue several requests without awaiting a response.

procedure Send_FC16
          (  Client    : in out MODBUS_Client;
             Reference : Reference_ID;
             Values    : Word_Array;
             Unit      : Unit_No := 255
          );

This procedure is called to send a Write Multiple Holding Register request. The execution is asynchronous, when completed Words_Written is called. Upon MODBUS exceptions Failed is called. Reference is any value the server will return back, e.g. a sequence number. Values is the words to write, they are encoded big-endian when sent. The array indices correspond to the addresses where to write the values. For example, if 1,2,3 has to be written at 3..5, Values must be:

(3=>1, 4=>2, 5=>3)

Unit is the slave to query. Use_Error is propagated when the server is not connected. Data_Error is propagated when the output buffer is full, e.g. when the client tries to queue several requests without awaiting a response.

procedure Send_FC22
          (  Client    : in out MODBUS_Client;
             Reference : Reference_ID;
             Address   : Word_Address;
             And_Mask  : Unsigned_16;
             Or_Mask  : Unsigned_16;
             Unit      : Unit_No := 255
          );

This procedure is called to send a Mask Write Register request. The execution is asynchronous, when completed Words_Written is called. Upon MODBUS exceptions Failed is called. Reference is any value the server will return back, e.g. a sequence number. Address is the word's address to mask. And_Mask is the mask to apply using AND. Or_Mask is the mask to apply using OR. Unit is the slave to query. Use_Error is propagated when the server is not connected. Data_Error is propagated when the output buffer is full, e.g. when the client tries to queue several requests without awaiting a response.

procedure Send_FC23
          (  Client    : in out MODBUS_Client;
             Reference : Reference_ID;
             From      : Word_Address;
             To        : Word_Address;
             Values
    : Word_Array;
             Unit      : Unit_No := 255
          );

This procedure is called to send a Read/Write Multiple Registers request. The execution is asynchronous, when completed Words_Read is called. Upon MODBUS exceptions Failed is called. Reference is any value the server will return back, e.g. a sequence number. From..To is the words range to read. Values is the words to write as in Send_FC16. The words are encoded big-endian when sent to the slave. Unit is the slave to query. Use_Error is propagated when the server is not connected. Data_Error is propagated when the output buffer is full, e.g. when the client tries to queue several requests without awaiting a response.

procedure Send_FC24
          (  Client    : in out MODBUS_Client;
             Reference : Reference_ID;
             Address   : Word_Address;
             Unit      : Unit_No := 255
          );

This procedure is called to send a Read FIFO queue request. The execution is asynchronous, when completed Words_Read is called with the data from the queue top. Upon MODBUS exceptions Failed is called. Reference is any value the server will return back, e.g. a sequence number. Address is the queue address. Unit is the slave to query. Use_Error is propagated when the server is not connected. Data_Error is propagated when the output buffer is full, e.g. when the client tries to queue several requests without awaiting a response.

procedure Set_RTU_Checksum_Mode
          (  Client : in out MODBUS_Client;
             Enable : Boolean
          );

This procedure is called after creation of the client to set its mode. By default the client implements MODBUS TCP/IP. When Enable is false the client is set into MODBUS RTU mode.

procedure Set_RTU_Silence_Time
          (  Client  : in out MODBUS_Client;
             Silence : Duration
          );

This procedure is called to set the MODBUS RTU silence time. It was no effect on MODBUS TCP/IP. The initial value of silence time is zero. When the silence time is greater than zero the procedures Send_FCx verify that the silence time is expired, otherwise they propagate Data_Error. Use Wait_RTU_Silence_Time in order to ensure its expiration.

procedure Wait_RTU_Silence_Time
          (  Client  : in out MODBUS_Client;
             Timeout : Duration
          );

This procedure awaits for the silence time to expire. It has no effect for MODBUS TCP/IP. It also has no effect on MODBUS RTU when the silence time is zero. When the silence time is not zero in MODBUS RTU mode, the procedure waits for all outgoing data to be sent and then the silence time after that. The parameter Timeout specifies the wait timeout. Timeout_Error is propagated when it expires before end of output and silence time.

procedure Words_Read
          (  Client    : in out MODBUS_Client;
             Reference : Reference_ID;
             Values    : Word_Array;
             Code      : Function_Code;
             Unit      : Unit_No
          );

This procedure is called when some words were successfully read. The read values are in set into the parameter Values. Note that the array indices do not correspond to the actual word addresses. The encoding of MODBUS words is assumed big-endian. Reference has the value passed to the server with the request. Code is the function code 3, 4, 23, 24 (FC3, FC4, FC23, FC24). Unit is the slave responding if more than one. The default implementation traces.

procedure Words_Written
          (  Client    : in out MODBUS_Client;
             Reference : Reference_ID;
             From      : Word_Address;
             To        : Word_Address;
             Code      : Function_Code;
             Unit      : Unit_No
          );

This procedure is called when some words were successfully written. From..To is the written range of addresses. Reference has the value passed to the server with the request. Code is the function code 6, 16, (FC6, FC16). Unit is the slave responding if more than one. The default implementation traces.

The package also provides an implementation of MODBUS RTU checksums:

type MODBUS_Checksum is private;

The following operations are defined on the checksum type:

procedure Accumulate
          (  CRC  : in out MODBUS_Checksum;
             Data : Stream_Element_Array
          );
procedure
Accumulate
          (  CRC  : in out MODBUS_Checksum;
             Data : Unsigned_8
          );

These procedures accumulate the checksum.

function Get (CRC : MODBUS_Checksum) return Stream_Element_Array;

This function returns the accumulated checksum as an array of two elements.

procedure Reset (CRC : in out MODBUS_Checksum);

This procedure resets the checksum.

17.13.1. Synchronous client

The package GNAT.Sockets.Connection_State_Machine.MODBUS_Client.Synchronous provides a MODBUS client to use with an external task in a synchronous way:

type MODBUS_Synchronous_Client
     (  Listener : access Connections_Server'Class
     )  is new Connection with private;

The client should be used from a task different from the multiple connections server's task. Only one request may be performed on the client at the time. It is possible to use operations from multiple tasks. The timeouts specified in the operations limit waiting for request completion but do not influence its execution. The timeouts do not limit waiting for an object to become free when used from another task. Note that when created the object must be referenced using a handle in order to prevent its premature destruction (see memory management of connection objects). The following primitive operations are provided:

procedure Cancel (Client : in out MODBUS_Synchronous_Client);

The procedure cancels the operation pending in another task. The corresponding operation propagates Cancel_Error declared in this package. Note that this has no effect on the communication performed by the client.

procedure Connect
          (  Client         : in out MODBUS_Synchronous_Client;
             Host           : String;
             Port           : Port_Type := MODBUS_Port;
             Max_Connect_No : Positive  := Positive'Last;
             Timeout        : Duration  := Duration'Last
          );

The procedure connects to the MODBUS server specified by Host. Port is the port number. Max_Connect_No is the total number of connection attempts before error is reported. Timeout is the connection timeout.

Exceptions
Cancel_Error Canceled by Cancel
Status_Error Failed to connect, attempts limit exhausted
Timeout_Error Timeout expired
Socket_Error Socket I/O errors

function {FC1|FC2}
         (  Client    : access MODBUS_Synchronous_Client;
            Reference : Reference_ID;
            From      : Bit_Address;
            To        : Bit_Address;
            Unit      : Unit_No  := 255;
            Timeout   : Duration := Duration'Last
         )  return Bit_Array;

These functions execute Read Coils and Read Discrete Inputs request. The result is the array of bits read. Reference is any value the server will return back, e.g. a sequence number. From..To is the bit range to read. Unit is the slave to query.

Exceptions
Cancel_Error Canceled by Cancel
MODBUS_Error The server responded with an exception status
Status_Error Connection was lost during the operation
Timeout_Error Timeout expired
Use_Error Not connected

function {FC3|FC4}
         (  Client    : access MODBUS_Synchronous_Client;
            Reference : Reference_ID;
            From      : Word_Address;
            To        : Word_Address;
            Unit      : Unit_No  := 255;
            Timeout   : Duration := Duration'Last
         )  return Word_Array;

These functions execute Read Holding Registers and Read Input Registers request. The result is the array of words read. Reference is any value the server will return back, e.g. a sequence number. From..To is the words range to read. Unit is the slave to query.

Exceptions
Cancel_Error Canceled by Cancel
MODBUS_Error The server responded with an exception status
Status_Error Connection was lost during the operation
Timeout_Error Timeout expired
Use_Error Not connected

procedure FC5
          (  Client    : in out MODBUS_Synchronous_Client;
             Reference : Reference_ID;
             Address   : Bit_Address;
             Value     : Boolean;
             Unit      : Unit_No  := 255;
             Timeout   : Duration := Duration'Last
          );

This procedure executes Write Single Coil request. Reference is any value the server will return back, e.g. a sequence number. Address is the bit address. Value is the value to write. Unit is the slave to query.

Exceptions
Cancel_Error Canceled by Cancel
MODBUS_Error The server responded with an exception status
Status_Error Connection was lost during the operation
Timeout_Error Timeout expired
Use_Error Not connected

procedure FC6
          (  Client    : in out MODBUS_Synchronous_Client;
             Reference : Reference_ID;
             Address   : Bit_Address;
             Value     : Unsigned_16;
             Unit      : Unit_No  := 255;
             Timeout   : Duration := Duration'Last
          );

This procedure executes Write Single Holding Register request. Reference is any value the server will return back, e.g. a sequence number. Address is the word address. Value is the value to write. Unit is the slave to query.

Exceptions
Cancel_Error Canceled by Cancel
MODBUS_Error The server responded with an exception status
Status_Error Connection was lost during the operation
Timeout_Error Timeout expired
Use_Error Not connected

function FC7
         (  Client    : access MODBUS_Synchronous_Client;
            Reference : Reference_ID;
            Unit      : Unit_No  := 255;
            Timeout   : Duration := Duration'Last
         )  return Unsigned_8;

This function executes Read Exception Status request. The result is the exception status. Reference is any value the server will return back, e.g. a sequence number. Unit is the slave to query.

Exceptions
Cancel_Error Canceled by Cancel
MODBUS_Error The server responded with an exception status
Status_Error Connection was lost during the operation
Timeout_Error Timeout expired
Use_Error Not connected

procedure FC15
          (  Client    : in out MODBUS_Synchronous_Client;
             Reference : Reference_ID;
             Value     : Bit_Array;
             Unit      : Unit_No  := 255;
             Timeout   : Duration := Duration'Last
          );

This procedure executes Write Multiple Coils request. Reference is any value the server will return back, e.g. a sequence number. Values is the bits to write. The array indices correspond to the addresses where to write the values. For example, if on, off, on has to be written at 3..5, Values must be:

(3=>True, 4=>False, 5=>True)

 Unit is the slave to query.

Exceptions
Cancel_Error Canceled by Cancel
MODBUS_Error The server responded with an exception status
Status_Error Connection was lost during the operation
Timeout_Error Timeout expired
Use_Error Not connected

procedure FC16
          (  Client    : in out MODBUS_Synchronous_Client;
             Reference : Reference_ID;
             Value     : Bit_Array;
             Unit      : Unit_No  := 255;
             Timeout   : Duration := Duration'Last
          );

This procedure executes Write Multiple Holding Registers request. Reference is any value the server will return back, e.g. a sequence number. Values is the words to write, they are encoded big-endian when sent. The array indices correspond to the addresses where to write the values. For example, if 1,2,3 has to be written at 3..5, Values must be:

(3=>1, 4=>2, 5=>3)

Unit is the slave to query.

Exceptions
Cancel_Error Canceled by Cancel
MODBUS_Error The server responded with an exception status
Status_Error Connection was lost during the operation
Timeout_Error Timeout expired
Use_Error Not connected

procedure FC22
          (  Client    : in out MODBUS_Synchronous_Client;
             Reference : Reference_ID;
             Address   : Word_Address;
             And_Mask  : Unsigned_16;
             Or_Mask   : Unsigned_16;
             Unit      : Unit_No  := 255;
             Timeout   : Duration := Duration'Last
          );

This procedure executes Mask Write Registers request. Reference is any value the server will return back, e.g. a sequence number. Address is the word's address to mask. And_Mask is the mask to apply using AND. Or_Mask is the mask to apply using OR. Unit is the slave to query.

Exceptions
Cancel_Error Canceled by Cancel
MODBUS_Error The server responded with an exception status
Status_Error Connection was lost during the operation
Timeout_Error Timeout expired
Use_Error Not connected

function FC23
         (  Client    : access MODBUS_Synchronous_Client;
            Reference : Reference_ID;
            From      : Word_Address;
            To        : Word_Address;
            Values
    : Word_Array;
            Unit      : Unit_No  := 255;
            Timeout   : Duration := Duration'Last
         )  return Word_Array;

These function executes Read/Write Multiple Registers request. The result is the array of words read. Reference is any value the server will return back, e.g. a sequence number. From..To is the words range to read. Values is the words to write. The words are encoded big-endian when sent to the slave.  Unit is the slave to query.

Exceptions
Cancel_Error Canceled by Cancel
MODBUS_Error The server responded with an exception status
Status_Error Connection was lost during the operation
Timeout_Error Timeout expired
Use_Error Not connected

function FC24
         (  Client    : access MODBUS_Synchronous_Client;
            Reference : Reference_ID;
            Address   : Word_Address;
            Unit      : Unit_No := 255;
            Timeout   : Duration := Duration'Last
         )  return Word_Array;

These function executes Read FIFO queue request. The result is the array of words from the queue top. Reference is any value the server will return back, e.g. a sequence number. Address is the queue address.  Unit is the slave to query.

Exceptions
Cancel_Error Canceled by Cancel
MODBUS_Error The server responded with an exception status
Status_Error Connection was lost during the operation
Timeout_Error Timeout expired
Use_Error Not connected

function Get_RTU_Checksum_Mode
         (  Client : MODBUS_Synchronous_Client
         )  return Boolean;

This function returns true if the client is in MODBUS RTU mode. The protocol of MODBUS RTU significantly differs from MODBUS TCP/IP. By default the client is in TCP/IP mode. Note that this is irrelevant to the transport layer. Both can be run over any transport. The RTU mode is set using the procedure Set_RTU_Checksum_Mode.

function Get_RTU_Silence_Time
         (  Client : MODBUS_Synchronous_Client
         )  return Duration;

This function returns the silence time used in the MODBUS RTU mode. The silence time is set using the procedure Set_RTU_Silence_Time. Initially the silence time is zero.

procedure Set_RTU_Checksum_Mode
          (  Client : in out MODBUS_Synchronous_Client;
             Enable : Boolean
          );

This procedure is called after creation of the client to set its mode. By default the client implements MODBUS TCP/IP. When Enable is false the client is set into MODBUS RTU mode.

procedure Set_RTU_Silence_Time
          (  Client  : in out MODBUS_Synchronous_Client;
             Silence : Duration
          );

This procedure is called to set the MODBUS RTU silence time. It was no effect on MODBUS TCP/IP. The initial value of silence time is zero. When set, the procedures FCx await for the silence time to expire.

[Back][TOC][Next]

17.14. ELV/e-Q3 MAX! Cube protocol implementation

The package GNAT.Sockets.Connection_State_Machine.ELV_MAX_Cube_Client provides an implementation of the ELV/e-Q3 MAX! Cube protocol. The device is a gateway to the radio-controlled home automation devices such as thermostats and shutter contacts. The client is suitable for working with a multiple connections server, e.g. with a single task handling multiple connections. It can also be used with a server backed by a pool of tasks.

Basic types and operations: The following data types are declared in the package:

type Room_ID is range 0..2**8-1;
No_Room : constant Room_ID;

Each room has an unique ID of this type. Devices, e.g. thermostats are assigned to the rooms. However some devices may have no room assigned.

type Ratio is delta 0.001 range 0.0..1.0;

This type is used, in particular, for valve positions. Ratio'First corresponds to a closed valve.

type Centigrade is delta 0.1 digits 4 range -4.0..135.0;

This type is used for temperatures. Values are specified in Celsius degrees. The value precision is 0.5 degree.

function Image (Value : Centigrade) return String;

This function returns a textual representation of temperature.

type RF_Address is range 0..2**24-1;
type RF_Address_Array is array (Positive range <>) of RF_Address;

This types are used for radio frequency addresses. Each device and room has a unique address.

function Image (Value : RF_Address) return String;

This function returns a textual representation of the address Value.

type Device_Type is
     (  Cube,
        Radiator_Thermostat,
        Radiator_Thermostat_Plus,
        Wall_Thermostat,
        Shutter_Contact,
        Eco_Button,
        Unknown
     );

Values of this type correspond to types of devices.

function Image (Kind_Of : Device_Type) return String;

This function returns a textual representation of the device type.

type Week_Day is (Mo, Tu, We, Th, Fr, Sa, Su);

This type describes days of week used in thermostat programming.

function Image (Day : Week_Day; Short : Boolean := True)
   return String;

This function returns a textual representation of the week day. When Short is true, the result is two characters long, e.g. Mo. Otherwise it is the full name, e.g. Monday.

type Week_Time is record
   Day  : Week_Day;
   Time : Day_Duration;
end record;

This type represents a week time. The field Day is the week day. The field Time is the time within the day (see Ada.Calendar).

function Minutes (Day : Day_Duration) return String;

This function returns a textual representation of the day time in minutes. The highest resolution of times used is in minutes.

function Minutes (Time : Day_Duration) return String;

This function returns a textual representation of the day time in hours and minutes. E.g. 13:00.

function Image (Time : Week_Time; Short : Boolean := True) return String;

This function returns a textual representation of the week time, e.g. Mo 05:00.

type Set_Point is record
   Last  : Day_Duration;
   Point : Centigrade;
end record;

A set point of the temperature profile defines the time Last until the temperature Point applies.

subtype Point_Count is Integer range 0..13;
subtype Point_Number is Point_Count range 1..Point_Count'Last;
type Points_List is array (Point_Number range <>) of Set_Point;
type Day_Schedule (Length : Point_Count := 0) is record
   Points : Points_List (1..Length);
end record;

The day schedule is an array of set points in time progressing order. The temperature of the last point applies to the rest of the day.

type Week_Schedule is array (Week_Day) of Day_Schedule;

The week schedule is an array of day schedules.

type Operating_Mode is (Automatic, Manual, Vacation, Boost);

This type specifies the operating mode of a device like thermostat:

type Device_Data (Kind_Of : Device_Type) is record
   Address       : RF_Address := 0;
   Error         : Boolean := False;
   Initialized   : Boolean := False;
   Battery_Low   : Boolean := False;
   Link_Error    : Boolean := False;
   Panel_Locked  : Boolean := False;
   Gateway_Known : Boolean := False;
   DST           : Boolean := False;
   Mode          : Operating_Mode := Automatic;
   case Kind_Of is
      when
Cube | Eco_Button | Unknown =>
         null;
      when Shutter_Contact =>
         Open : Boolean := False;
      when Radiator_Thermostat..Wall_Thermostat =>
         Set_Temperature : Centigrade := 18.0; -- As kept by the thermostat
        
New_Temperature : Centigrade := 18.0; -- Last requested temperature
         Temperature     : Centigrade := Centigrade'First; -- Measured temperature
         case Kind_Of is
            when
Radiator_Thermostat |
                 Radiator_Thermostat_Plus =>
               Valve_Position     : Ratio := 0.0;
               Latest_Temperature : Centigrade := Centigrade'First;
               Received_At        : Time;
            when others =>
               null;
         end case;
   end case;
end record;

Values of this type describe the state of a device as obtained from the cube. Meaning of the fields:

function Image (Data : Device_Data) return String;

This function returns a textual representation of the device data.

type Device_Parameters
     (  Kind_Of     : Device_Type;
        Name_Length : Natural
     )  is
record

   Room      : Room_ID;
   Address   : RF_Address;
   Serial_No : String (1..10);
   Name      : String (1..Name_Length);
   case Kind_Of is
      when
Cube | Shutter_Contact | Eco_Button | Unknown =>
         null;
      when Radiator_Thermostat..Wall_Thermostat =>
         Comfort     : Centigrade := 18.0;
         Eco         : Centigrade := 18.0;
         Max         : Centigrade := 18.0;
         Min         : Centigrade := 18.0;
         Offset      : Centigrade := 0.0;
         Window_Open : Centigrade := 18.0;
         Schedule    : Week_Schedule;
         case Kind_Of is
            when
Radiator_Thermostat | Radiator_Thermostat_Plus =>
               Window_Time     : Duration := 10.0;
               Boost_Time      : Duration := 1.0;
               Boost_Valve     : Ratio    := 0.5;
               Decalcification : Week_Time;
               Max_Valve       : Ratio;
               Valve_Offset    : Ratio;
            when others =>
               null;
         end case;
   end case;
end record;

This type describes parameters of a device.

ELV_MAX_Cube_Port : constant Port_Type := 62910;

This is the default MAX! cube port.

Client type and operations:

The package declares the ELV_MAX_Cube_Client connection object type:

type ELV_MAX_Cube_Client
     (  Listener       : access Connections_Server'Class;
        Line_Length    : Positive;
        Input_Size     : Buffer_Length;
        Output_Size    : Buffer_Length;
        Secondary_Size : Storage_Count
     )  is new State_Machine with private;

The discriminants are:

The following operations are defined of the client:

procedure Add_New_Device
          (  Client       : in out ELV_MAX_Cube_Client;
             Room_Name    : String;
             Kind_Of      : Room_Device_Type;
             Serial_No    : String;
             Device_Name  : String;
             Address      : RF_Address;
             ID           : in out Room_ID;
           [ S_Commands ] : out Natural;
             Mode         : Setting_Mode := S_Command or S_Response
          );
procedure Add_New_Device
          (  Client       : in out ELV_MAX_Cube_Client;
             Index        : Positive;
             Kind_Of      : Room_Device_Type;
             Serial_No    : String;
             Device_Name  : String;
             Address      : RF_Address;
           [ S_Commands ] : out Natural;
             Mode         : Setting_Mode := S_Command or S_Response
          );
procedure Add_New_Device
          (  Client       : in out ELV_MAX_Cube_Client;
             ID           : Room_ID;
             Kind_Of      : Room_Device_Type;
             Serial_No    : String;
             Device_Name  : String;
             Address      : RF_Address;
           [ S_Commands ] : out Natural;
             Mode         : Setting_Mode := S_Command or S_Response
          );
procedure Add_New_Device
          (  Client       : in out ELV_MAX_Cube_Client;
             Serial_No    : String;
             Device_Name  : String;
             Address      : RF_Address;
           [ S_Commands ] : out Natural;
             Mode         : Setting_Mode := S_Command or S_Response
          );

These procedures are used to add a new device, e.g. discovered per pairing (see Pair). The device can be added

Other parameters are:

When a device is added it is linked with other devices in the room. All thermostats are linked with shutter contacts. Wall thermostats are linked with radiator thermostats. The parameter Mode specifies execution method. When S_Command is specified the device is linked to the cube. When S_Response is specified the device is added in the local cache. The default is both sending to the cube and updating the local cache. If there is a danger that the cube may reject the command it must be called first as S_Command and second as S_Response after confirmation to update the cache. For a newly created room S_Command set ID to the new room ID. It must be passed to the S_Respose call. The parameter S_Commands returns the number of issued s-commands.

Exceptions
Constraint_Error Wrong room number, wrong room or device name length
End_Error There is no such room when specified by ID
Name_Error The device with this address already exists
Socket_Error I/O error, connection is dropped
Use_Error The output buffer is full (connection is preserved)

procedure Attach_Device
          (  Client       : in out ELV_MAX_Cube_Client;
             Device       : RF_Address;
             Index        : Positive;
           [ S_Commands ] : out Natural;
             Mode         : Setting_Mode := S_Command or S_Response
          );
procedure
Attach_Device
          (  Client       : in out ELV_MAX_Cube_Client;
             Device       : RF_Address;
             ID           : Room_ID;
           [ S_Commands ] : out Natural;
             Mode         : Setting_Mode := S_Command or S_Response
          );
procedure
Attach_Device
          (  Client       : in out ELV_MAX_Cube_Client;
             Device       : RF_Address;
             Name         : String;
           [ S_Commands ] : out Natural;
             Mode         : Setting_Mode := S_Command or S_Response
          );

These procedures attaches a previously detached device (see Detach_Device) to another room. The device is specified by its RF-address. The room is specified by its number in the range 1..Get_Number_Of_Rooms (Client) or by its identifier. Nothing happens if the device is already in that room. When room is specified by the parameter Name it can be a new room to create or an existing room. The parameter Mode specifies execution method. When S_Command is specified the device is moved and linked to other devices in the room. When S_Response is specified the topology is updated. The default is both sending to the cube and updating. If there is a danger that- the cube may reject the command it must be called first as S_Command and second as S_Response after confirmation to update the cache. The parameter S_Commands returns the number of issued s-commands.

Exceptions
Constraint_Error Invalid room number Index
End_Error No room with the ID or no detached device. When there is no room with Name, End_Error is not raised and a new room is created
Socket_Error I/O error, connection is dropped
Use_Error The output buffer is full (connection is preserved)

procedure Cancel_Pairing
          (  Client : in out ELV_MAX_Cube_Client
          );

This procedure cancels pairing initiated by Pair.

Exceptions
Socket_Error I/O error, connection is dropped
Use_Error The output buffer is full (connection is preserved)

procedure Configuration_Updated
          (  Client : in out ELV_MAX_Cube_Client;
             Update : Update_Data
          );

This procedure is called upon connection handshake when a portion data is received. The parameter Update indicates what was updated:

package Servers_List is new Generic_Indefinite_Set (String);
type
Update_Type is
     (  Cube_Update,
        Topology_Update,
        Device_Parameters_Update,
        Device_Discovery_Update,
        End_Discovery_Update,
        NTP_Servers_List_Update
     );

The value of Update_Type specifies the information type:

The fields of the parameter Update are as follows:

type Update_Data (Kind_Of : Update_Type) is record
   case
Kind_Of is
      when
Cube_Update          |
           Topology_Update      |
           End_Discovery_Update =>
         null;
      when Detached_Device_Update   |
           Device_Parameters_Update |
           Device_Discovery_Update  =>
         Device  : Device_Type; -- The device type
         Address : RF_Address;  -- Of the device updated
         case Kind_Of is
            when
Device_Discovery_Update | Detached_Device_Update =>
               Serial_No : String (1..10);
            when others =>
               null;
         end case;
      when NTP_Servers_List_Update =>
         NTP_Servers_List : Servers_List.Set; -- NTP servers
   end case;
end record;

The default implementation prints data when the type of update is Device_Discovery_Update, End_Discovery_Update or NTP_Servers_List_Update.

procedure Data_Received
          (  Client : in out ELV_MAX_Cube_Client;
             Data   : Device_Data
          );

This procedure is called when data from a device are received. The cube polls the devices and their data back to the client upon handshake or when data are requested (see Query_Devices). The default implementation does some tracing. It likely should be overridden, e.g. to store the data. The parameter Data has the type Device_Data.

procedure Delete
          (  Client       : in out ELV_MAX_Cube_Client;
             List         : RF_Address_Array;
           [ S_Commands ] : out Natural;
             Mode         : Setting_Mode := S_Command or S_Response
          );

This procedure deletes devices and rooms that lose all devices. The parameter List is the list of RF-addresses of the devices to remove. The parameter Mode specifies execution method. When S_Command is specified the devices are deleted from the cube. When S_Response is specified the device and the rooms are deleted in the local cache. The default is both sending to the cube and updating the local cache. If there is a danger that the cube may reject the command it must be called first as S_Command and second as S_Response after confirmation to update the cache. The parameter S_Commands returns the number of issued s-commands.

Exceptions
Socket_Error I/O error, connection is dropped
Use_Error The output buffer is full (connection is preserved)

procedure Delete_Device
          (  Client       : in out ELV_MAX_Cube_Client;
             Address      : RF_Address;
           [ S_Commands ] : out Natural;
             Mode         : Setting_Mode := S_Command or S_Response
          );

This procedure deletes single device and the room if it contains no other devices. The parameter Mode specifies execution method. The parameter S_Commands returns the number of issued s-commands.

Exceptions
End_Error There is no such device
Socket_Error I/O error, connection is dropped
Use_Error The output buffer is full (connection is preserved)

procedure Delete_Room
          (  Client       : in out ELV_MAX_Cube_Client;
             Index        : Positive;
           [ S_Commands ] : out Natural;
             Mode         : Setting_Mode := S_Command or S_Response
          );
procedure
Delete_Room
          (  Client       : in out ELV_MAX_Cube_Client;
             ID           : Room_ID;
           [ S_Commands ] : out Natural;
             Mode         : Setting_Mode := S_Command or S_Response
          );

These procedures remove a room with all devices in the room. The room can be specified by number Index in the range 1..Get_Number_Of_Rooms (Client) or the room identifier. The parameter Mode specifies execution method. The parameter S_Commands returns the number of issued s-commands.

Exceptions
Constraint_Error Wrong room number
End_Error There is no room with the specified ID
Socket_Error I/O error, connection is dropped
Use_Error The output buffer is full (connection is preserved)

procedure Detach_Device
          (  Client       : in out ELV_MAX_Cube_Client;
             Device       : RF_Address;
           [ S_Commands ] : out Natural;
             Mode         : Setting_Mode := S_Command or S_Response
          );

These procedures are used to detach a device from a room in order to attach it later to another. A device moving is done by first detaching (Detach_Device) and then re-attaching it (Attach_Device). It is two separate operations because the cube cannot move a device in one single step. The parameter Mode specifies execution method.  When S_Command is specified the device is unlinked from the room devices. When S_Response is specified the topology is updated. The default is both sending to the cube and updating the local cache. If there is a danger that the cube may reject the command it must be called first as S_Command and second as S_Response after confirmation. The parameter S_Commands returns the number of issued s-commands.

Exceptions
End_Error No such device
Socket_Error I/O error, connection is dropped
Use_Error The output buffer is full (connection is preserved)

procedure Disconnected (Client : in out ELV_MAX_Cube_Client);

This procedure is called when the client loses connection to the cube. If overridden the new implementation shall call the parent's one from its body.

procedure Initialize (Client : in out ELV_MAX_Cube_Client);

This procedure is called upon object construction. It must be called from the new implementation if overridden.

procedure Faulty_Device_Received
          (  Client      : in out ELV_MAX_Cube_Client;
             Address     : RF_Address;
             Length      : Natural;
             Valid       : Boolean;
             Error       : Boolean;
             Initialized : Boolean;
             Orphaned    : Boolean
          );

This procedure is called when a faulty device is reported by the cube. Address is the RF-address of the device. Length is the device's data length. Valid, Error, Initialized are device status bits reported by the cube. Orphaned indicates that the device does not appear in the topology. Typically it is a device which was paired but then left unconfigured. The default implementation does tracing. A reasonable reaction would be deletion of any faulty devices.

function Find_Room
         (  Client : ELV_MAX_Cube_Client;
            ID     : Room_ID
         )  return Positive;

This function is called to find a room by its ID. The returned value is the room number in the range 1..Get_Number_Of_Rooms (Client). End_Error is propagated when there is no room with ID.

function Get_Clock_Difference
         (  Client : ELV_MAX_Cube_Client)
         )  return Duration;

This function returns the time skew between cube and host clocks: Tcube - Thost. Status_Error is propagated when there is no connection to the cube.

function Get_Device
         (  Client  : ELV_MAX_Cube_Client;
            Address : RF_Address
         )  return Positive;

This function returns the number of the device with the given radio frequency address. The result is in the range 1..Get_Number_Of_Devices (Client).

function Get_Device
         (  Client : ELV_MAX_Cube_Client;
            Index  : Positive;
            Device : Positive
         )  return Positive;
function
Get_Device
         (  Client : ELV_MAX_Cube_Client;
            ID     : Room_ID;
            Device : Positive
         )  return Positive;

This function returns the number of the device in the room specified by the room number Index in the range 1..Get_Number_Of_Rooms (Client) or the room identifier and the number Device counted from 1 through all devices in the room. The result is in the range 1..Get_Number_Of_Devices (Client). Constraint_Error is propagated when room or device number is out of range. The function allows to enumerate all devices in a room. The number of devices in a room is returned by the variant of Get_Number_Of_Devices with the room number as the parameter. End_Error is propagated when there is no such room.

function Get_Device_Data
         (  Client : ELV_MAX_Cube_Client;
            Index  : Positive
         )  return Device_Data;
function
Get_Device_Data
         (  Client  : ELV_MAX_Cube_Client;
            Address : RF_Address
         )  return Device_Data;

These functions return the device data. The device can be specified by its number in the range 1..Get_Number_Of_Devices (Client) or by its radio frequency address. Constraint_Error is propagated when the device number is out of range. End_Error is propagated when there is no device with the specified address. Status_Error is propagated when the device has not yet sent any data.

function Get_Device_Name
         (  Client : ELV_MAX_Cube_Client;
            Index  : Positive
         )  return String;
function
Get_Device_Name
         (  Client  : ELV_MAX_Cube_Client;
            Address : RF_Address
         )  return String;

These functions return the device name. The device can be specified by its number in the range 1..Get_Number_Of_Devices (Client) or by its radio frequency address. Constraint_Error is propagated when the device number is out of range. End_Error is propagated when there is no device with the specified address.

function Get_Device_Room
         (  Client : ELV_MAX_Cube_Client;
            Index  : Positive
         )  return Room_ID;
function
Get_Device_Room
         (  Client  : ELV_MAX_Cube_Client;
            Address : RF_Address
         )  return Room_ID;

These functions return the room of device. The device can be specified by its number in the range 1..Get_Number_Of_Devices (Client) or by its radio frequency address. Constraint_Error is propagated when the device number is out of range. End_Error is propagated when there is no device with the specified address. Note that some devices may have no room associated with them. For such devices No_Room is returned.

function Get_Device_Parameters
         (  Client : ELV_MAX_Cube_Client;
            Index  : Positive
         )  return Device_Parameters;
function
Get_Device_Parameters
         (  Client  : ELV_MAX_Cube_Client;
            Address : RF_Address
         )  return Device_Parameters;

These functions return the device parameters. The device can be specified by its number in the range 1..Get_Number_Of_Devices (Client) or by its radio frequency address. Constraint_Error is propagated when the device number is out of range. End_Error is propagated when there is no device with the specified address.

function Get_Device_RF_Address
         (  Client : ELV_MAX_Cube_Client;
            Index  : Positive
         )  return RF_Address;

This function returns the device parameters. The device is specified by its number in the range 1..Get_Number_Of_Devices (Client). Constraint_Error is propagated when the device number is out of range.

function Get_Device_Serial_No
         (  Client : ELV_MAX_Cube_Client;
            Index  : Positive
         )  return String;
function
Get_Device_Serial_No
         (  Client  : ELV_MAX_Cube_Client;
            Address : RF_Address
         )  return String;

These functions return the device serial number, e.g. KEQ0828854. It is ten characters long. The device can be specified by its number in the range 1..Get_Number_Of_Devices (Client) or by its radio frequency address. Constraint_Error is propagated when the device number is out of range. End_Error is propagated when there is no device with the specified address.

function Get_Device_Type
         (  Client : ELV_MAX_Cube_Client;
            Index  : Positive
         )  return Device_Type;
function
Get_Device_Type
         (  Client  : ELV_MAX_Cube_Client;
            Address : RF_Address
         )  return Device_Type;

These functions return the device type. The device can be specified by its number in the range 1..Get_Number_Of_Devices (Client) or by its radio frequency address. Constraint_Error is propagated when the device number is out of range. End_Error is propagated when there is no device with the specified address.

function Get_Duty (Client : ELV_MAX_Cube_Client) return Ratio;

This functions return the current value of the duty cycle.

function Get_Error
         (  Client : ELV_MAX_Cube_Client
         )  return Boolean;

This function returns true if the last 's' command was rejected by the cube. The command is issued for configuring and changing operating mode of the device:

function Get_Metadata
         (  Client : ELV_MAX_Cube_Client
         )  return String;

This function returns the metadata describing to topology of the devices and rooms in the format used by the cube. It can be used for the purpose of backing up the cube's configuration. See also Reset_Metadata and Put. The format of metadata is native to the cube as used in the m-command.

function Get_Number_Of_Devices
         (  Client : ELV_MAX_Cube_Client
         )  return Natural;

This function returns the number of devices. It becomes known shortly after successful connection to the cube, when the cube sends its configuration to the client. Between connections the number of devices is 0.

function Get_Number_Of_Devices
         (  Client : ELV_MAX_Cube_Client;
            Index  : Positive
         )  return Natural;
function Get_Number_Of_Devices
         (  Client : ELV_MAX_Cube_Client;
            ID     : Room_ID
         )  return Natural;

This function returns the number of devices in the room specified by its number in the range 1..Get_Number_Of_Rooms (Client) or by its identifier. Constraint_Error is propagated when Index is out of the range. End_Error is propagated when there is no room with the specified identifier.

function Get_Number_Of_Rooms
         (  Client : ELV_MAX_Cube_Client
         )  return Natural;

This function returns the number of rooms. The number becomes known shortly after successful connection to the cube, when the cube sends its configuration to the client. Between connections the number of rooms is 0.

function Get_RF_Address
         (  Client    : ELV_MAX_Cube_Client;
            Unchecked : Boolean := False
         )  return RF_Address;

This function returns the radio frequency address of the cube. Status_Error is propagated when there is no connection yet. When Unchecked is true no exception is propagated and the last know cube address is returned. It can be 0 if the address is unknown.

function Get_Room_ID
         (  Client : ELV_MAX_Cube_Client;
            Index  : Positive
         )  return Room_ID;

This function returns the room ID. The room is specified by its number in the range 1..Get_Number_Of_Rooms (Client). Constraint_Error is propagated when Room is out of the range.

function Get_Room_Name
         (  Client : ELV_MAX_Cube_Client;
            Index  : Positive
         )  return String;
function Get_Room_Name
         (  Client : ELV_MAX_Cube_Client;
            ID     : Room_ID
         )  return String;

This functions return the room name. The room is specified by its number in the range 1..Get_Number_Of_Rooms (Client) or by its identifier. Constraint_Error is propagated when Room is out of the range. End_Error is propagated when there is no room with the specified identifier.

function Get_Room_RF_Address
         (  Client : ELV_MAX_Cube_Client;
            Index  : Positive
         )  return RF_Address;
function Get_Room_RF_Address
         (  Client : ELV_MAX_Cube_Client;
            ID     : Room_ID
         )  return RF_Address

This functions return the room radio frequency address. The address is one of the main room device. The room is specified by its number in the range 1..Get_Number_Of_Rooms (Client) or by its identifier. Constraint_Error is propagated when Room is out of the range. End_Error is propagated when there is no room with the specified identifier.

function Get_Serial_No
         (  Client : ELV_MAX_Cube_Client
         )  return String;

This function returns the ten characters serial number of the cube. Status_Error is propagated when there is no connection yet.

function Get_Version
         (  Client : ELV_MAX_Cube_Client
         )  return String;

This function returns the firmware version of the cube, e.g. 1.1.3. Status_Error is propagated when there is no connection yet.

procedure Handshake_Received (Client : in out ELV_MAX_Cube_Client);

This procedure is called when a handshake packet has been received from the cube and processed. It is a right place to perform on-connect actions. The procedure Connected would be premature because it lacks any data about the cube which come first with the handshake packet. For example the cube address becomes known after the handshake. The default implementation does nothing.

function Has_Device_Configuration
         (  Client : ELV_MAX_Cube_Client;
            Index  : Positive
         )  return Boolean;
function
Has_Device_Configuration
         (  Client  : ELV_MAX_Cube_Client;
            Address : RF_Address
         )  return Boolean;

These functions return true if the device configuration is known. After initial handshake which announces connected devices the cube sends a series of messages describing the devices. During this period of time the device settings are unknown. These functions can be used to determine this condition. A device can be specified by its number in the range 1..Get_Number_Of_Devices (Client) or by its radio frequency address. Constraint_Error is propagated when the device number is out of range. When the device address is wrong, the result is false. Note that only thermostats and shutter contacts have settings. For other device types the no settings are ever sent by the cube and thus these functions will always return false. The function Is_Configured can be used to determine if all thermostats and shutter contacts have their settings defined.

function Has_Device_Data
         (  Client : ELV_MAX_Cube_Client;
            Index  : Positive
         )  return Boolean;
function
Has_Device_Data
         (  Client  : ELV_MAX_Cube_Client;
            Address : RF_Address
         )  return Boolean;

These functions return true if the device data are available. The device can be specified by its number in the range 1..Get_Number_Of_Devices (Client) or by its radio frequency address. Constraint_Error is propagated when the device number is out of range. End_Error is propagated when there is no device with the specified address.

function Is_Configured
         (  Client : ELV_MAX_Cube_Client
         )  return Boolean;

This function returns true if the handshake and the consequent informational message were received from the cube in Client. In effect the topology of the rooms and devices is known as well as all device settings.

function Is_In
         (  Client : ELV_MAX_Cube_Client;
            Device : RF_Address
         )  return Boolean;

This function returns true if a device with the address Device is attached to be cube Client is connected to.

function Is_In
         (  Client : ELV_MAX_Cube_Client;
            Index  : Positive;
            Device : Positive
         )  return Boolean;
function Is_In
         (  Client : ELV_MAX_Cube_Client;
            ID     : Room_ID;
            Device : Positive
         )  return Boolean;

This functions return true if the room specified by the room number Index in the range 1..Get_Number_Of_Rooms (Client) contains a device with the number Device counted from 1 through all devices in the room. The room can also be specified by its identifier. When either of the numbers is out of range the result is false.

procedure Pair
          (  Client  : in out ELV_MAX_Cube_Client;
             Timeout : Duration := 60.0
          );

This procedure sets the cube into the pairing mode used to discover new devices. A device in order to be discovered must be set into the pairing mode too. The parameter Timeout specifies the operation duration. When a new device is found Configuration_Updated is called with the parameters of the device and the discriminant Device_Discovery_Update. When the cube leaves discovery mode Configuration_Updated is called with the discriminant End_Discovery_Update. The newly found device is always paired to the cube. In order to reverse pairing effect Delete must be called.

Exceptions
Constraint_Error Invalid timeout
Socket_Error I/O error, connection is dropped
Use_Error The output buffer is full (connection is preserved)

function Put
         (  Destination : in out String;
            Pointer     : in out Integer;
            Client      : ELV_MAX_Cube_Client
         );

This procedure stores the metadata into Destination starting from the position Pointer. Pointer is advanced to the first free character after the output. Layout_Error is propagated when there is no room for the output.

procedure Query_Device_Configuration
          (  Client  : in out ELV_MAX_Cube_Client;
             Address : RF_Address
          );

This procedure queries the configuration of the device specified by Address. When a response is obtained Configuration_Updated is called. Socket_Error is propagated on I/O errors. Use_Error is propagated when the output buffer is full. In the latter case the connection is not dropped and the application may try to call this procedure later (from another callback).

procedure Query_Devices
          (  Client : in out ELV_MAX_Cube_Client
          );

The cube sends actual status of the devices once immediately after connection. To actualize the status this procedure is called. In both cases when a response is obtained Data_Received is called per each device which data are found in the response. Socket_Error is propagated on I/O errors. Use_Error is propagated when the output buffer is full. In the latter case the connection is not dropped and the application may try to call this procedure later (from another callback).

procedure Query_NTP_Servers
          (  Client : in out ELV_MAX_Cube_Client
          );

The cube sends back the list of NTP servers it uses. When a response is obtained Configuration_Updated is called. Socket_Error is propagated on I/O errors. Use_Error is propagated when the output buffer is full. In the latter case the connection is not dropped and the application may try to call this procedure later (from another callback).

procedure Query_Uconfigured_Devices
          (  Client : in out ELV_MAX_Cube_Client
          );

This procedure queries the configuration of all devices for which no configuration data yet known. When a response is obtained Configuration_Updated is called. Socket_Error is propagated on I/O errors. Use_Error is propagated when the output buffer is full. In the latter case the connection is not dropped and the application may try to call this procedure later (from another callback). Normally the cube sends the configuration data of all devices and there is no need to call this one.

procedure Rename_Device
          (  Client  : in out ELV_MAX_Cube_Client;
             Address : RF_Address;
             Name    : String
          );

This procedure renames a device. The device is specified by its RF-address.

Exceptions
Constraint_Error Invalid device name (longer then 255 characters)
End_Error No such device
Socket_Error I/O error, connection is dropped
Use_Error The output buffer is full (connection is preserved). Set_Metadata could be used to attempt recovery

procedure Rename_Room
          (  Client : in out ELV_MAX_Cube_Client;
             Index  : Positive;
             Name   : String
          );
procedure
Rename_Room
          (  Client : in out ELV_MAX_Cube_Client;
             ID     : Room_ID;
             Name   : String
          );

These procedures rename a room. The room is specified by its number in the range 1..Get_Number_Of_Rooms (Client) or by its identifier.

Exceptions
Constraint_Error Invalid room name (longer then 255 characters) or the room index is not in range
End_Error No such room
Socket_Error I/O error, connection is dropped
Use_Error The output buffer is full (connection is preserved). Set_Metadata could be used to attempt recovery

procedure Reset_Devices (Client : in out ELV_MAX_Cube_Client);

The cube will drop all connected devices and in effect delete all rooms. Socket_Error is propagated on I/O errors. Use_Error is propagated when the output buffer is full. In the latter case the connection is not dropped and the application may try to call this procedure later (from another callback).

procedure Reset_Error (Client : in out ELV_MAX_Cube_Client);

This procedure resets error. Socket_Error is propagated on I/O errors. Use_Error is propagated when the output buffer is full. In the latter case the connection is not dropped and the application may try to call this procedure later (from another callback).

procedure Reset_Metadata
          (  Client       : in out ELV_MAX_Cube_Client;
             Data         : String;
           [ S_Commands ] : out Natural
          );

The command overwrites the cube's metadata describing the rooms and devices. The data are same as reported in Get_Metadata. All existing devices and rooms are replaced from the ones from Data. The devices are linked again. The number of issued s-commands is returned via the parameter S_Commands. In addition one a-command is issued to store new metadata into the cube.

Exceptions
Constraint_Error The block is longer than 1900 characters
Socket_Error I/O error, connection is dropped
Use_Error The output buffer is full (connection is preserved)

procedure Set_Metadata (Client : in out ELV_MAX_Cube_Client);

The command overwrites the cube's metadata describing the rooms and devices as known to Client.

Exceptions
Socket_Error I/O error, connection is dropped
Use_Error The output buffer is full (connection is preserved)

procedure Set_NTP_Servers
          (  Client : in out ELV_MAX_Cube_Client;
             List   : String
          );
procedure Set_NTP_Servers
          (  Client : in out ELV_MAX_Cube_Client;
             List   : Servers_List.Set
          );

These procedures set a new list of NTP servers for the cube to use. List is either a comma separated list of server names, e.g.  "de.pool.ntp.org,ntp.homematic.com" or else it is a set of strings with the server name.

procedure Set_Thermostat_Automatic
          (  Client      : in out ELV_MAX_Cube_Client;
             Index       : Positive;
             Temperature : Centigrade := Centigrade'First
          );
procedure Set_Thermostat_Automatic
          (  Client      : in out ELV_MAX_Cube_Client;
             Address     : RF_Address;
             Temperature : Centigrade := Centigrade'First
          );

These procedures set a thermostat device in the automatic mode. The device can be specified by its number in the range 1..Get_Number_Of_Devices (Client) or by its radio frequency address. The parameter Temperature if specified overrides the schedule's set temperature for the current time interval. After the interval expiration the thermostat will follow the schedule.

Exceptions
Constraint_Error The device number is out of range 1..Get_Number_Of_Devices
End_Error There is no device with the specified address
Mode_Error The device is not a thermostat
Socket_Error I/O error, connection is dropped
Use_Error The output buffer is full (connection is preserved)

procedure Set_Thermostat_Boost
          (  Client : in out ELV_MAX_Cube_Client;
             Index  : Positive
          );
procedure Set_Thermostat_Boost
          (  Client  : in out ELV_MAX_Cube_Client;
             Address : RF_Address
          );

These procedures set a thermostat device in the boost mode. After boost sequence completion the device returns to its previous mode. The device can be specified by its number in the range 1..Get_Number_Of_Devices (Client) or by its radio frequency address.

Exceptions
Constraint_Error The device number is out of range 1..Get_Number_Of_Devices
End_Error There is no device with the specified address
Mode_Error The device is not a thermostat
Socket_Error I/O error, connection is dropped
Use_Error The output buffer is full (connection is preserved)

procedure Set_Thermostat_Display
          (  Client      : in out ELV_MAX_Cube_Client;
             Index       : Positive;
             Temperature : Display_Mode
          );
procedure Set_Thermostat_Display
          (  Client      : in out ELV_MAX_Cube_Client;
             Address     : RF_Address;
             Temperature : Display_Mode
          );

These procedures set the display mode of a wall mounted thermostat device. The device can be specified by its number in the range 1..Get_Number_Of_Devices (Client) or by its radio frequency address. The parameter Temperature specifies the temperature to indicate:

type Display_Mode is
     (  Display_Set_Temperature,
        Display_Is_Temperature
     );

Exceptions
Constraint_Error The device number is out of range 1..Get_Number_Of_Devices
End_Error There is no device with the specified address
Mode_Error The device is not a wall mounted thermostat
Socket_Error I/O error, connection is dropped
Use_Error The output buffer is full (connection is preserved)

procedure Set_Thermostat_Parameters
          (  Client      : in out ELV_MAX_Cube_Client;
             Index       : Positive;
             Comfort     : Centigrade;
             Eco         : Centigrade;
             Max         : Centigrade;
             Min         : Centigrade;
             Offset      : Centigrade;
             Window_Open : Centigrade;
           [ Window_Time : Day_Duration; ]
             Mode      
 : Setting_Mode := S_Command or S_Response
          );
procedure Set_Thermostat_Parameters
          (  Client      : in out ELV_MAX_Cube_Client;
             Address     : RF_Address;
             Comfort     : Centigrade;
             Eco         : Centigrade;
             Max         : Centigrade;
             Min         : Centigrade;
             Offset      : Centigrade;
             Window_Open : Centigrade;
           [ Window_Time : Day_Duration; ]
             Mode        : Setting_Mode := S_Command or S_Response
          );

These procedures set thermostat device parameters. For a wall mounted thermostat parameters Window_Open and Window_Time are omitted. The device can be specified by its number in the range 1..Get_Number_Of_Devices (Client) or by its radio frequency address. The parameter Mode specifies execution method.

type Setting_Mode is mod 4;
S_Command  : constant Setting_Mode := 1;
S_Response : constant Setting_Mode := 2;

When S_Command is specified the parameters are sent to the cube. When S_Response is specified the parameters are set into the local cache. The default is both sending to the cube and updating the local cache. If there is a danger that the cube may reject the command it must be called first as S_Command and second as S_Response after confirmation to update the cache.

Exceptions
Constraint_Error The device number is out of range 1..Get_Number_Of_Devices
End_Error There is no device with the specified address
Mode_Error The device is not a thermostat
Socket_Error I/O error, connection is dropped
Use_Error The output buffer is full (connection is preserved)

procedure Set_Thermostat_Schedule
          (  Client   : in out ELV_MAX_Cube_Client;
             Index    : Positive;
             Day      : Week_Day;
             Schedule : Points_List;
             Mode     : Setting_Mode := S_Command or S_Response
          );
procedure Set_Thermostat_Schedule
          (  Client   : in out ELV_MAX_Cube_Client;
             Address  : RF_Address;
             Day      : Week_Day;
             Schedule : Points_List;
             Mode     : Setting_Mode := S_Command or S_Response
          );

These procedures are used to set the thermostat's day program. The device can be specified by its number in the range 1..Get_Number_Of_Devices (Client) or by its radio frequency address. The list of points must be sorted end time ascending. Note that there is no way to get confirmation that the schedule is set. The object assumes that it was and updates the schedule cached in the memory. The actual schedule will be read only upon a new connection. The parameter Mode specifies execution method. When S_Command is specified the schedule is sent to the cube. When S_Response is specified the schedule is set into the local cache. The default is both sending to the cube and updating the local cache. If there is a danger that the cube may reject the command it must be called first as S_Command and second as S_Response after confirmation to update the cache. Note that this procedure uses two s-commands to set the schedule.

Exceptions
Constraint_Error The device number is out of range 1..Get_Number_Of_Devices
End_Error There is no device with the specified address
Mode_Error Illegal program or not a thermostat
Socket_Error I/O error, connection is dropped
Use_Error The output buffer is full (connection is preserved)

procedure Set_Thermostat_Temperature
          (  Client      : in out ELV_MAX_Cube_Client;
             Index       : Positive;
             Temperature : Centigrade;
             Manual      : Boolean := True
          );
procedure
Set_Thermostat_Temperature
          (  Client      : in out ELV_MAX_Cube_Client;
             Index       : Positive;
             Temperature : Centigrade;
             Up_Until    : Time
          );
procedure Set_Thermostat_Temperature
          (  Client      : in out ELV_MAX_Cube_Client;
             Address     : RF_Address;
             Temperature : Centigrade;
             Manual      : Boolean := True
          );
procedure Set_Thermostat_Temperature
          (  Client      : in out ELV_MAX_Cube_Client;
             Address     : RF_Address;
             Temperature : Centigrade;
             Up_Until    : Time
          );

These procedures set thermostat temperature. The parameter Manual controls switching the thermostat into the manual mode if the current mode is not manual. When the thermostat is in the automatic mode and Manual is false, the thermostat remains in the automatic mode. In this case it will keep the temperature until expiration of the current time interval. After that it will follow the schedule. When the parameter Up_Until is specified, it is the time until the temperature is set before the device returns to its previous mode. The device can be specified by its number in the range 1..Get_Number_Of_Devices (Client) or by its radio frequency address.

procedure Set_Thermostat_Valve
          (  Client          : in out ELV_MAX_Cube_Client;
             Index           : Positive;
             Boost_Time      : Duration     := 3.0;
             Boost_Valve     : Ratio        := 1.0;
             Decalcification : Week_Time    := (Mo, 12.0 * 3600.0);
             Max_Valve       : Ratio        := 1.0;
             Valve_Offset    : Ratio        := 0.0;
             Mode            : Setting_Mode := S_Command or S_Response
          );
procedure Set_Thermostat_Valve
          (  Client          : in out ELV_MAX_Cube_Client;
             Address         : RF_Address;
             Boost_Time      : Duration     := 3.0;
             Boost_Valve     : Ratio        := 1.0;
             Decalcification : Week_Time    := (Mo, 12.0 * 3600.0);
             Max_Valve       : Ratio        := 1.0;
             Valve_Offset    : Ratio        := 0.0;
             Mode            : Setting_Mode := S_Command or S_Response
          );

These procedures set radiator thermostat valve parameters. The device can be specified by its number in the range 1..Get_Number_Of_Devices (Client) or by its radio frequency address. The parameter Mode specifies execution method. When S_Command is specified the valve parameters are sent to the cube. When S_Response is specified the parameters are set into the local cache. The default is both sending to the cube and updating the local cache. If there is a danger that the cube may reject the command it must be called first as S_Command and second as S_Response after confirmation to update the cache.

Exceptions
Constraint_Error The device number is out of range 1..Get_Number_Of_Devices
End_Error There is no device with the specified address
Mode_Error The device is not a thermostat
Socket_Error I/O error, connection is dropped
Use_Error The output buffer is full (connection is preserved)

procedure Set_Time
          (  Client : in out ELV_MAX_Cube_Client;
             Winter : Zone_Data := CET;
             Summer : Zone_Data := CEST
          );

This procedure sets the cube clock. The parameters Winter and Summer specify the time to be used for winter and summer time correspondingly. The type Time_Zone is declared as follows:

subtype Time_Zone_Offset is Duration range -12.0 * 3_600.0
                                        ..  12.0 * 3_600.0;
subtype Time_Zone_Name_Count is Natural range 0..5;
type Day_Of_Week is (Su, Mo, Tu, We, Th, Fr, Sa);
type Hour_Number is range 0..23;
type Zone_Data (Length : Time_Zone_Name_Count := 0) is record
   Start  : Month_Number;       -- The month when it start to apply
   Offset : Time_Zone_Offset;   -- The UTC offset
   Name   : String (1..Length); -- The abbreviated name
end record;

There are predefined constants for a few time zones defined in the child package GNAT.Sockets.Connection_State_Machine.ELV_MAX_Cube_Client.Time_Zones.

GMT  : constant Zone_Data;
BST  : constant Zone_Data;
CET  : constant Zone_Data;
CEST : constant Zone_Data;
MET  : constant Zone_Data;
EET  : constant Zone_Data;
EEST : constant Zone_Data;
FET  : constant Zone_Data;
FEST : constant Zone_Data;
MSK  : constant Zone_Data;
MSD  : constant Zone_Data;

Exceptions
Socket_Error I/O error, connection is dropped
Unknown_Zone_Error The time zone of the computer is not properly set
Use_Error The output buffer is full (connection is preserved)

procedure Status_Received
          (  Client : in out ELV_MAX_Cube_Client;
             Error  : Boolean;
             Duty   : Ratio;
             Slots  : Natural
          );

This procedure is called when command response from a device is received. The default implementation calls to Trace. It likely should be overridden, e.g. to store the data. Error is true when the last command was rejected. Duty indicates how much the radio traffic was used. When it reaches 1 the cube stops communicating with the device. Slots is the number of free memory slots.

procedure Trace
          (  Client  : in out ELV_MAX_Cube_Client;
             Message : Boolean
          );

This procedure is called to perform higher-level tracing. By default it uses Trace of the factory.

LAN discovery: MAX! cubes in the LAN can be discovered via broadcast. The following data types describe a cube:

type Cube_Descriptor is record
   Address   : Inet_Addr_Type;
   Name      : String (1..8);
   Serial_No : String (1..10);
end record;
type Cube_Descriptor_Array is
   array
(Positive range <>) of Cube_Descriptor;

Here:

The function

function Discover
         (  Timeout  : Timeval_Duration := 2.0;
            Attempts : Positive         := 2;
            Host     : String           := "";
            Port     : Port_Type        := 23272
         )  return Cube_Descriptor_Array;

returns an array of discovered MAX! cubes. Timeout is the overall operation duration. Attempts is the number of broadcast queries sent. Host is the official address of the host in the LAN. When omitted the first host address is taken. Port is the broadcast port. Socket_Error is propagated on I/O errors. Host_Error is propagated on host naming errors.

Cube reboot: MAX! cubes in the LAN can be rebooted using the following procedure:

procedure Reboot (Serial_No : String; Port : Port_Type := 23272);

Seria_No is the 10 character of the cube serial number. Port is the broadcast port. Socket_Error is propagated on I/O errors.

Topology data lock: MAX! cube client maintains the known topology task-safe. The following helper type can be used for locking topology updates:

type Topology_Holder
     (  Client : access constant ELV_MAX_Cube_Client'Class
     )  is new Ada.Finalization.Limited_Controlled with null record;
procedure Finalize   (Lock : in out Topology_Holder);
procedure Initialize (Lock : in out Topology_Holder);;

When the object is initialized the lock is seized and released upon finalization. The operation is reentrant. The same task can take the lock any number of times.

function Image_Metadata (Data : String) return String;

This function returns a human readable representation of the metadata describing topology. Data_Error is propagated when Data is invalid.

procedure Put_Metadata
          (  Destination : in out String;
             Pointer     : in out Integer;
             Data        : String
          );

This procedure places a human readable representation of the metadata describing topology into Destination starting at the position Pointer. Pointer is advanced to the next position. Data_Error is propagated when Data is invalid. Layout_Error is propagated when there is no room for output or else Pointer is outside Destination'First..Destination'Last + 1.

17.14.1. Stream I/O

The package GNAT.Sockets.Connection_State_Machine.ELV_MAX_Cube_Client.Stream_IO provides stream I/O operations for basic types declared in the parent package. The operations can be used for storing schedules and device parameters into files or databases.

17.14.2. Topology

The package GNAT.Sockets.Connection_State_Machine.ELV_MAX_Cube_Client.Topology provides means to decode cube topology. It declares the following types:

type Device_Topology_Data (Length : Natural) is record
   Kind_Of   : Device_Type;
   Address   : RF_Address := 0;
   Room      : Room_ID;
   Serial_No : String (1..10);
   Name      : String (1..Length);
end record;
type Device_Topology_Data_Ptr is access Device_Topology_Data;
type Device_Topology_Data_Ptr_Array is
   array
(Positive range <>) of Device_Topology_Data_Ptr;

These data types describe a device in the cube's topology. Each device in the decoded topology has an instance of Device_Topology_Data.

type Room_Topology_Data
     (  Length : Natural;
        Count  : Natural
     )  is
record

   ID      : Room_ID;
   Master  : RF_Address;
   Name    : String (1..Length);
   Devices : Device_Topology_Data_Ptr_Array (1..Count);
end record;
type Room_Topology_Data_Ptr is access Room_Topology_Data;
type Room_Topology_Data_Ptr_Array is
   array
(Positive range <>) of Room_Topology_Data_Ptr;

These data types describe a room in the cube's topology. Each device in the decoded topology has an instance of Room_Topology_Data. Its member Devices is an array of devices from the room.

type Topology_Data
     (  Rooms_Count   : Natural;
        Devices_Count : Natural
     )  is new Ada.Finalization.Controlled with
record

   Rooms   : Room_Topology_Data_Ptr_Array   (1..Rooms_Count);
   Devices : Device_Topology_Data_Ptr_Array (1..Devices_Count);
end record;

This data type describes the topology of a cube. The member Rooms is an array of rooms. The member Devices is an array of roomless devices.

function Get_Topology (Data : String) return Topology_Data;

This function decodes topology description Data as returned by the function Get_Metadata and returns the corresponding instance of Topology_Data. Data_Error is propagated when Data has invalid format.

[Back][TOC][Next]

17.15. MQTT protocol implementation

Message Queueing Telemetry Transport (MQTT) is an ISO standard (ISO/IEC PRF 20922) messaging protocol. The protocol is TCP or WebSockets based and supports publishing and subscribing to messages identified by UTF-8 encoded names, so-called topics. There is no topic any registration procedure. Topics are introduced ad-hoc. A message is an untyped bucket of octets, represented in the implementation by a stream-element array. It is up to the message publisher or subscriber to interpret the message content. Multiple clients may subscribe to the same topic. Additionally to this messages can be retained on the server to ensure late delivery to the clients staying off-line while publishing. A subscriber may require three levels of delivery acknowledgement (at most once, at least once, exactly once). For further information see.

The MQTT protocol architecture is relatively heavy-weight, especially because topics are introduced ad-hoc. Possibly it is also the reason why the protocol supports neither naming nor browsing services. Server discovery services are not provided either. The protocol lacks time stamping, message instance identification, live lock detection. Published messages are not filtered, nor there is publishing confirmation, rejection or other form of data returned to the message's issuer.

The implementation provides:

For MQTT on WebSockets the HTTP client HTTP_WebSocket_Client or its derivative is used.

16.15.1. MQTT peer

The package GNAT.Sockets.MQTT provides a minimal implementation of a MQTT peer. It can be used to implement end MQTT devices that need no messages brokering. The implementation is not task-safe. All calls must be performed on the context of the connection server, e.g. in response to incoming requests. The package defines the type of a MQTT peer:

type MQTT_Peer
     (  Listener             : access Connections_Server'Class;
        Max_Subscribe_Topics : Positive;
        Input_Size           : Buffer_Length;
        Output_Size          : Buffer_Length
     )  is new Connection with private;

The type is derived from Connection object and can act both as a server and client. The dicriminants of the type are:

General-purpose operations. The following general-purpose primitive operations are defined on MQTT_Peer:

procedure Finalize (Peer : in out MQTT_Peer);

The procedure is called when the object is destroyed. If overridden it must be called from the new implementation.

function Get_Max_Message_Size (Peer : MQTT_Peer)
   return Stream_Element_Count;

The function returns the current limit set on the message size. The limit can be set using the procedure Set_Max_Message_Size.

function Get_Max_Secondary_Buffer_Size
         (  Peer : MQTT_Peer
         )  return Stream_Element_Count;

The function returns upper limit of the secondary buffer. The secondary buffer is allocated on demand when the output buffer becomes full. The size of the buffer is limited by Set_Max_Secondary_Buffer_Size. Zero limit means unlimited buffer. By default  the secondary buffer size is not limited.

function Get_QoS
         (  Peer  : MQTT_Peer;
            Index : Positive
         )  return QoS_Level;

The function returns the quality of service requested for the topic with the number Index. This function can be used only in the callback of a SUBSCRIBE request (On_Subscribe), otherwise Use_Error is propagated. Constraint_Error is propagated when Index is greater than the number of subscribed topics.

function Get_Secondary_Buffer_Size
         (  Peer : MQTT_Peer
         )  return Stream_Element_Count;

The function returns actual size of the secondary buffer. The secondary buffer is allocated on demand when the output buffer becomes full. The size of the buffer can be limited (see Set_Max_Secondary_Buffer_Size). If limited overflow will cause data overrun exception.

function Get_Topic
         (  Peer  : MQTT_Peer;
            Index : Positive
         )  return String;

The function returns the topic with the number Index. This function can be used only in the callback of a SUBSCRIBE (see On_Subscribe) or an UNSUBSCRIBE (see On_Unsubscribe) request, otherwise Use_Error is propagated. Constraint_Error is propagated when Index is greater than the number of subscribed topics.

procedure Received
          (  Peer    : in out MQTT_Peer;
             Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset);

The procedure is called when a portion of data is received. The implementation parses input and fires the state machine implementing the MQTT stack.

procedure Sent (Peer : in out MQTT_Peer);

The procedure is called when a portion of data is sent. The implementation moves data from the secondary buffer to the output buffer. If overridden it must be called from the new implementation.

procedure Set_Max_Message_Size
          (  Peer : in out MQTT_Peer;
             Size : Stream_Element_Count
          );

The procedure sets the limit on the message size. This is the maximum size of a message that does not include packet header, topic name etc. For the message the peer object keeps a buffer allocated. The current limit can be queried by Get_Max_Message_Size.

procedure Set_Max_Secondary_Buffer_Size
          (  Peer : in out MQTT_Peer;
             Size : Stream_Element_Count := 0
          );

The procedure sets the limit to the secondary buffer size. The buffer is allocated on demand. When Size set to zero the buffer is not limited. Otherwise buffer overflow causes exception. See Get_Max_Secondary_Buffer_Size.

Incoming requests notifications. The following primitive operations are called upon an incoming packet:

procedure On_Acknowledge
          (  Peer    : in out MQTT_Peer;
             Request : Acknowledge_Type;
             Packet  : Packet_Identifier
          );

The procedure is called when an acknowledge response is received. The parameter Request identifies the response. Packet is the packet identifier. The default implementation calls Send_Acknowledge when an acknowledge is expected, i.e. for:

In other cases the implementation does nothing.

procedure On_Connect
          (  Peer         : in out MQTT_Peer;
             Client       : String;
             Clean        : Boolean;
             Will_Topic   : String;
             Will_Message : Stream_Element_Array;
             Will_QoS     : QoS_Level;
             Will_Retain  : Boolean;
             User_Name    : String;
             Password     : String;
             Keep_Alive   : Duration
          );

The procedure is called when a CONNECT request is received. Client is the client identifier. When empty an anonymous session is created. Otherwise the server must take the saved session with this identifier if exists. When Clean is false and the saved session is found, the session is continued, e.g. its subscriptions are reactivated etc. When Clean is true, the existing session is erased. Will_Topic, Will_Message, Will_QoS and Will_Retain determine the behavior when the client gets prematurely disconnected. In this case, when Will_Topic is not empty, the topic is published by the server. The parameter Will_QoS is the quality of service of the topic. The parameter Will_Retain when true specifies that the will topic is retained by the server. I.e. it can be subscribed and received after being published. When Will_Retain is false the topic is delivered only to connected clients. User_Name and Password can be used for the client authentication. Keep_Alive when greater than zero specifies how frequently the client must send its requests. When there is nothing to request the client must send a PINGREQ request instead. If the client fails to send a request within this period of time, the server drops the connection. The default implementation of this procedure rejects all connections.

procedure On_Connect_Accepted
          (  Peer            : in out MQTT_Peer;
             Session_Present : Boolean
          );

The procedure is called when a successful connection acknowledge CONNACK is received. Session_Present is true when the server has found and resumed the previous session identified by the client (see the Client parameter of On_Connect). The default implementation does nothing.

procedure On_Connect_Rejected
          (  Peer     : in out MQTT_Peer;
             Response : Connect_Response
          );

The procedure is called when a failed connection acknowledge CONNACK is received. Response is the server's response code. The default implementation does nothing.

procedure On_Disconnect (Peer : in out MQTT_Peer);

The procedure is called when a DISCONNECT request is received. This is the last request a client sends to the server. When the client does not send this request before dropping connection, the server will publish its last will (see On_Connect). The default implementation does nothing.

procedure On_Ping (Peer : in out MQTT_Peer);

The procedure is called when a PINGREQ request is received. The default implementation responds with a ping response.

procedure On_Ping_Response (Peer : in out MQTT_Peer);

The procedure is called when a PINGRESP response is received. The default implementation does nothing.

procedure On_Publish
          (  Peer      : in out MQTT_Peer;
             Topic     : String;
             Message   : Stream_Element_Array;
             Packet    : Packet_Identification;
             Duplicate : Boolean;
             Retain    : Boolean
          );

The procedure is called when a PUBLISH request is received. The parameter Topic is the published topic. Published topics may not contain wildcards. See Check_Topic for further information. The parameter Message is the published message. The parameter Packet identifies the packet. The response if any must contain this number. Duplicate is true if the server suspects that the recipient might already have received this message. Retain is true if the message is sent after the client has subscribed to the topic and the server discovered this message retained on the server. The default implementation acknowledges the request according to the QoS_Level specified in Packet:

procedure On_Subscribe
          (  Peer          : in out MQTT_Peer;
             Packet        : Packet_Identifier;
             Topics_Number : Positive
          );

The procedure is called when a SUBSCRIBE request is received. The parameter Packet identifies the packet. The parameter Topics_Number specifies the number of subscribed tokens. The maximum number of topics is limited by the object discriminant Max_Subscribe_Topics. The requested topic and quality of service is obtained by the functions Get_Topic and Get_QoS correspondingly. Subscribed topics may contain wildcards. See Check_Topic and Match_Topic for details. The default implementation rejects all requested topics in the returned SUBACK.

procedure On_Subscribe_Acknowledgement
          (  Peer   : in out MQTT_Peer;
             Packet : Packet_Identifier;
             Codes  : Return_Code_List
          );

The procedure is called when a SUBACK response is received. The parameter Packet identifies the packet. The array Codes contains a Return_Code for each subscribed topic. The default implementation does nothing.

procedure On_Unsubscribe
          (  Peer          : in out MQTT_Peer;
             Packet        : Packet_Identifier;
             Topics_Number : Positive
          );

The procedure is called when a UNSUBSCRIBE request is received. The parameter Packet identifies the packet. The parameter Topics_Number specifies the number of tokens to unsubscribe. The maximum number of topics is limited by the object discriminant Max_Subscribe_Topics. The requested topic is obtained by the function Get_Topic. The default implementation acknowledges the receipt by sending UNSUBACK back.

Sending outgoing requests. The following primitive operations are used to send requests:

procedure Send_Acknowledge
          (  Peer    : in out MQTT_Peer;
             Request : Acknowledge_Type;
             Packet  : Packet_Identifier
          );

The procedure sends an acknowledge response specified by the parameter Request to PUBLISH (and following responses) or UNSUBSCRIBE. The parameter Packet identifies the request's packet. Use_Error is propagated when Peer is not connected. Data_Error is propagated on secondary buffer overflow if its size is limited by Set_Max_Secondary_Buffer_Size.

procedure Send_Connect
          (  Peer         : in out MQTT_Peer;
             Client       : String;
             Clean        : Boolean              := True;
             Will_Topic   : String               := "";
             Will_Message : Stream_Element_Array := (1..0 => 0);
             Will_QoS     : QoS_Level            := At_Most_Once;
             Will_Retain  : Boolean              := False;
             User_Name    : String               := "";
             Password     : String               := "";
             Keep_Alive   : Duration             := 0.0
          );

The procedure sends a CONNECT request. The parameters are same as in On_Connect. This must be the first request sent by a client to the server after connection is established. Constraint_Error is propagated if a parameter is invalid. Use_Error is propagated when Peer is not connected. Data_Error is propagated on secondary buffer overflow if its size is limited by Set_Max_Secondary_Buffer_Size.

procedure Send_Connect_Accepted
          (  Peer            : in out MQTT_Peer;
             Session_Present : Boolean := False
          );

The procedure sends a CONNACK response. The parameters are same as in On_Connect_Accepted. Use_Error is propagated when Peer is not connected. Data_Error is propagated on secondary buffer overflow if its size is limited by Set_Max_Secondary_Buffer_Size.

procedure Send_Connect_Rejected
          (  Peer     : in out MQTT_Peer;
             Response : Connect_Response
          );

The procedure sends a CONNACK response. The parameters are same as in On_Connect_Rejected. Use_Error is propagated when Peer is not connected. Data_Error is propagated on secondary buffer overflow if its size is limited by Set_Max_Secondary_Buffer_Size.

procedure Send_Disconnect (Peer : in out MQTT_Peer);

The procedure sends a DISCONNECT request. This must be the last request from a client before it drops the connection. Use_Error is propagated when Peer is not connected. Data_Error is propagated on secondary buffer overflow if its size is limited by Set_Max_Secondary_Buffer_Size.

procedure Send_Ping (Peer : in out MQTT_Peer);

The procedure sends a PINGREQ request. Use_Error is propagated when Peer is not connected. Data_Error is propagated on secondary buffer overflow if its size is limited by Set_Max_Secondary_Buffer_Size.

procedure Send_Ping_Response (Peer : in out MQTT_Peer);

The procedure sends a PINGRES response. Use_Error is propagated when Peer is not connected. Data_Error is propagated on secondary buffer overflow if its size is limited by Set_Max_Secondary_Buffer_Size.

procedure Send_Publish
          (  Peer      : in out MQTT_Peer;
             Topic     : String;
             Message   : Stream_Element_Array;
             Packet    : Packet_Identification;
             Duplicate : Boolean := False;
             Retain    : Boolean := False
          );
procedure
Send_Publish
          (  Peer      : in out MQTT_Peer;
             Topic     : String;
             Message   : String;
             Packet    : Packet_Identification;
             Duplicate : Boolean := False;
             Retain    : Boolean := False
          );

These procedures send a PUBLISH request. The parameters are similar to ones in On_Publish. The parameter Message can be Stream_Element_Array or String. Constraint_Error is propagated if a parameter is invalid. Use_Error is propagated when Peer is not connected. Data_Error is propagated on secondary buffer overflow if its size is limited by Set_Max_Secondary_Buffer_Size.

procedure Send_Publish
          (  Peer      : in out MQTT_Peer;
             Message   : MQTT_Message'Class;
             Packet    : Packet_Identification;
             Duplicate : Boolean := False;
             Retain    : Boolean := False
          );

This variant sends a message stored in MQTT_Message object. Use_Error is propagated when Peer is not connected. Data_Error is propagated on secondary buffer overflow if its size is limited by Set_Max_Secondary_Buffer_Size.

procedure Send_Subscribe
          (  Peer   : in out MQTT_Peer;
             Packet : Packet_Identifier;
             Topics : Topics_List;
             QoS    : QoS_Level_Array
          );
procedure Send_Subscribe
          (  Peer   : in out MQTT_Peer;
             Packet : Packet_Identifier;
             Topic  : String;
             QoS    : QoS_Level
          );

These procedures send a SUBSCRIBE request. The parameter Packet is the packet number with is used by the peer to acknowledge subscription. The parameter Topics is the list of topics to subscribe. The parameter QoS the array of QoS_Level. Both parameters must have the same length otherwise Constraint_Error is propagated. An alternative variant is used to subscribe to single topic with Topic and QoS parameters. Use_Error is propagated when Peer is not connected. Data_Error is propagated on secondary buffer overflow if its size is limited by Set_Max_Secondary_Buffer_Size.

procedure Send_Subscribe_Acknowledgement
          (  Peer   : in out MQTT_Peer;
             Packet : Packet_Identifier;
             Codes  : Return_Code_List
          );

The procedure sends a SUBACK response. The parameter Packet is the packet number, same as in SUBSCRIBE request. The parameters are same as in On_Subscribe_Acknowledgement. Use_Error is propagated when Peer is not connected. Data_Error is propagated on secondary buffer overflow if its size is limited by Set_Max_Secondary_Buffer_Size.

procedure Send_Unsubscribe
          (  Peer   : in out MQTT_Peer;
             Packet : Packet_Identifier;
             Topics : Topics_List
          );

The procedure sends a UNSUBSCRIBE request. The parameter Packet is the packet number which will identify the response. The parameter Topics is the list of topics to unsubscribe. The procedure is void when Topics is empty. Constraint_Error is propagated if a parameter is invalid. Use_Error is propagated when Peer is not connected. Data_Error is propagated on secondary buffer overflow if its size is limited by Set_Max_Secondary_Buffer_Size.

Handling topics. Topics are UTF-8 encoded and consist of levels separated by the forward slash /. The topics are case-sensitive, e.g. Abc/deF is different from abc/def. The following functions are used for handling topics:

function Check_Topic (Topic : String) return Boolean;

This function checks its argument for validity. The result is true if the topic contains wildcards + and #. The wildcard + matches any level. The wildcard # matches any number of level, it must be the last character of the topic if present. Constraint_Error is propagated when the topic is invalid.

function Match_Topic
         (  Topic   : String;
            Pattern : String
         )  return Boolean;

This function matches Topic against Pattern. The result is true is Pattern matches Topic. Note that topics starting with $ are not matched by patterns starting with a wildcard. Constraint_Error is propagated when Topic or Pattern is invalid.

Other types and subprograms. The following types and subprograms are declared in the package:

MQTT_Port : constant := 1883;

MQTT_Port is the default MQTT port.

type QoS_Level is (At_Most_Once, At_Least_Once, Exactly_Once);

This is quality of service requested for message publishing:

type QoS_Level_Array is array (Positive range <>) of QoS_Level;

This is an array of QoS_Level elements.

function Image (QoS : QoS_Level) return String;

This function returns a textual representation of a QoS_Level value.

function "+" (Left, Right : QoS_Level) return QoS_Level;

This function merges two values of QoS_Level choosing the maximum level of quality.

type Acknowledge_Type is
     (  Publish_Level_1,
        Publish_Level_2_Received,
        Publish_Level_2_Release,
        Publish_Level_2_Complete,
        Unsubscribed
     );

This is the type of acknowledge:

function Image (Value : Acknowledge_Type) return String;

This function returns a textual representation of the argument.

type Connect_Response is range 1..255;

This type represents reasons of a CONNECT request failure. The following values are predefined:

Unacceptable_Protocol_Version : constant Connect_Response := 1;
Identifier_Rejected           : constant Connect_Response := 2;
Server_Unavailable            : constant Connect_Response := 3;
Bad_User_Name_Or_Password     : constant Connect_Response := 4;
Not_Authorized                : constant Connect_Response := 5;

function Image (Code : Connect_Response) return String;

This function returns a textual representation of a Connect_Response value.

type Packet_Identifier is new Unsigned_16;

Values of this type identify packets. Responses to a request use the request's packet number.

type Packet_Identification
     (  QoS : QoS_Level := At_Most_Once
     )  is
record
   case
QoS is
      when
At_Most_Once =>
         null;
      when At_Least_Once | Exactly_Once =>
         ID : Packet_Identifier;
   end case;
end record;

Values of this type identify packets dealing with different quality of service. The level At_Most_Once does not identify packets because it does not deploy acknowledgement.

type Return_Code (Success : Boolean := False) is record
   case
Success is
      when
True =>
         QoS : QoS_Level;
      when False =>
         null;
   end case;
end record;

Values of this are used in a response to a SUBSCRIBE request. Successful requests contain the quality of service.

type Return_Code_List is array (Positive range <>) of Return_Code;

This is an array of Return_Code elements.

Lists of topics.

type Topics_List (<>) is private;
function Get_Length (List : Topics_List) return Natural;
function Get_Topic (List : Topics_List; Index : Positive) return String;
function "+" (Left : String) return Topics_List;
function "/" (Left : String;      Right : String) return Topics_List;
function "/" (Left : Topics_List; Right : String) return Topics_List;

Ordered lists of topics are provided by the type Topic_List. The list can be composed from individual topics using operations /. E.g.

"$SYS/broker/uptime" / "$SYS/broker/load/#"

Composite message object.

type MQTT_Message is tagged private;

Objects of this type represent a composite message object.

function Compose
         (  Topic   : String;
            Message : Stream_Element_Array
         )  return MQTT_Message;
function Compose
         (  Topic   : String;
            Message : String
         )  return MQTT_Message;

These functions create a new message object from the topic and the message content. Constraint_Error is propagated when Topic is invalid.

function Get_Topic
         (  Message : MQTT_Message
         )  return String;

This function gets the message topic. Constraint_Error is propagated when the message object was not initialized.

function Get_Message
         (  Message : MQTT_Message
         )  return Stream_Element_Array;
function
Get_Message
         (  Message : MQTT_Message
         )  return String;

This function gets the message contents. Constraint_Error is propagated when the message object was not initialized.

procedure Set_Message
          (  Message : in out MQTT_Message;
             Content : Stream_Element_Array
          );
procedure Set_Message
          (  Message : in out MQTT_Message;
             Content : String
          );

This procedure replaces the message's content. Constraint_Error is propagated when the message object was not initialized.

procedure Set_Size
          (  Message : in out MQTT_Message;
             Size    : Stream_Element_Count
          );

This procedure ensures that the message can accommodate at least Size elements of content. Constraint_Error is propagated when the message object was not initialized.

procedure Set_Topic
          (  Message : in out MQTT_Message;
             Topic   : String
          );

This procedure replaces the message's topic. Constraint_Error is propagated when the topic is invalid. An uninitialized message can be initialized using this procedure.

17.15.2. MQTT message stream I/O

The package GNAT.Sockets.MQTT.Streams provides stream interface to the MQTT message contents. The package declares the following type:

type MQTT_Stream (Message : access MQTT_Message'Class) is
   new
Root_Stream_Type with private;

The primitive operations defined on MQTT_Stream:

procedure Erase (Stream : in out MQTT_Stream);

This procedure prepares the stream for writing the message's contents. The contents are erased. Writing the stream starts from the first element of the message contents. The message's contents are expanded as necessary upon stream writing.

procedure Rewind (Stream : in out MQTT_Stream);

This procedure prepares the stream for reading the message's contents. Reading the stream starts from the first element of the message contents.

17.15.3. MQTT server (broker)

The package GNAT.Sockets.MQTT.Server provides a full implementation of a MQTT broker that supports subscriptions and publishing. The implementation is task-safe allowing publishing from asynchronous tasks. The broker is represented by the type MQTT_Server:

type MQTT_Server is
   new
Ada.Finalization.Limited_Controlled with private;

The server maintains the state shared between several MQTT connections. It keeps so-called retained messages and persistent MQTT sessions of named clients. When a message is published on the server it is delivered to all subscribers managed by the server. The server provides means to manage retained messages and sessions.

The following primitive operations are defined on the type:

procedure Drop
          Server : in out MQTT_Server;
             Name   : String
          );
procedure
Drop
          Server : in out MQTT_Server;
             Index  : Positive
          );

This procedure removes a persistent session by its name or index. Nothing happens when there no session with Name. When Index not in 1..Get_Sessions_Number Constraint_Error is propagated. Note that if the session is active, i.e. a connect client uses it, the session will be removed after the client disconnects.

function Get_Tracing_Flags
         (  Server : MQTT_Server
         )  return MQTT_Trace_Flags;

This function returns the current tracing flags in effect. The trace flags are:

type MQTT_Trace_Flags is mod ...;
Trace_Acknowledgement : constant MQTT_Trace_Flags := ...;
Trace_Sessions        : constant MQTT_Trace_Flags := ...;
Trace_Subscriptions   : constant MQTT_Trace_Flags := ...;
Trace_Ping            : constant MQTT_Trace_Flags := ...;
Trace_Pubishing       : constant MQTT_Trace_Flags := ...;
Trace_All             : constant MQTT_Trace_Flags := ...;

Tracing flags are set using the procedure Set_Tracing_Flags.

function Get_Message
         (  Server : MQTT_Server;
            Index  : Integer
         )  return MQTT_Message;

This function returns a retained message by its index 1..Get_Messages_Number. Constraint_Error is propagated when Index is invalid.

function Get_Message
         (  Server : MQTT_Server;
            Topic  : String
         )  return MQTT_Message;
function
Get_Message
         (  Server : MQTT_Server;
            Topic  : String
         )  return Integer;

This function returns a retained message by its topic. Constraint_Error is propagated when Topic is invalid or contains wild-cards. The variant returning message propagates End_Error when there is no such message. The variant returning Integer does either the message index or else 0 if there is no such message.

function Get_Messages_Number
         (  Server : MQTT_Server
         )  return Natural;

This function returns the total number of messages retained by the server:

type Message_Type is
     (  Transient,
        Retained,
        Updated,
        Initial,
        Ignored
     );

The type Message_Type specifies how a message is handled when published on the server:

function Get_Queue_Size
         (  Server : MQTT_Server
         )  return Positive;

This function returns the maximum number queued messages per a connection. Published messages are queued to be sent to a client. When the queue becomes full the connection to the client is dropped. The procedure Set_Queue_Size is used to set the limit.

function Get_Session
         (  Server : MQTT_Server;
            Name   : String
         )  return Integer;

This function returns the index of session by it name. The result is 0 if there is no such session.

function Get_Session_Name
         (  Server : MQTT_Server;
            Index  : Positive
         )  return String;

This function returns the name of the session with the number 1..Get_Sessions_Number. Anonymous clients have sessions with empty names. End_Error is propagated when Index is illegal.

function Get_Session_Time
         (  Server : MQTT_Server;
            Name   : String
         )  return Time;
function Get_Session_Time
         (  Server : MQTT_Server;
            Index  : Positive
         )  return Time;

This function returns the last time the session identified by its name or the number 1..Get_Sessions_Number has an exchange with a client. End_Error is propagated when Index is illegal or no session with this name exists.

function Get_Sessions_Number
         (  Server : MQTT_Server;
         )  return Natural;

This function returns the number of sessions active or not.

function Is_Session_Active
         (  Server : MQTT_Server;
            Name   : String
         )  return Boolean;
function Is_Session_Active
         (  Server : MQTT_Server;
            Index  : Positive
         )  return Boolean;

This function returns true if the session identified by its name or the number 1..Get_Sessions_Number is active, i.e. has a connected client. End_Error is propagated when Index is illegal or no session with this name exists.

function Is_Tracing_On
         (  Server : MQTT_Server;
            Flags  : MQTT_Trace_Flags
         )  return Boolean;

This function returns true if one the flags in Flags is in effect.

procedure Publish
          Server  : in out MQTT_Server;
             Topic   : String;
             Message : Stream_Element_Array;
             QoS     : QoS_Level    := At_Most_Once;
             Policy  : Message_Type := Transient
          );
procedure
Publish
          Server  : in out MQTT_Server;
             Topic   : String;
             Message : String;
             QoS     : QoS_Level    := At_Most_Once;
             Policy  : Message_Type := Transient
          );

These procedures are used to publish a message. The message is propagated to all clients subscribed to the topic specified by the parameter Topic. Message is the published message which can be either a Stream_Element_Array or String. QoS specifies the quality of service. Policy specifies how to handle the message.

type MQTT_Messages_Array is
   array
(Positive range <>) of MQTT_Message;

procedure
Publish
          Server  : in out MQTT_Server;
             Message : MQTT_Message;
             QoS     : QoS_Level    := At_Most_Once;
             Policy  : Message_Type := Transient
          );
procedure
Publish
          Server   : in out MQTT_Server;
             Messages : MQTT_Messages_Array;
             QoS      : QoS_Level    := At_Most_Once;
             Policy   : Message_Type := Transient
          );

These variants publish single message Message or a couple of messages stored in the array Messages. Invalid Message or elements of Messages are ignored.

procedure Received
          Server  : in out MQTT_Server;
             Client  : in out MQTT_Connection'Class;
             Topic   : String;
             Message : Stream_Element_Array
             QoS     : QoS_Level;
             Policy  : in out Message_Type
          );

This procedure is called for each incoming message. The parameter Client is the client publishing the message. The parameters Topic, Message, QoS are the message parameters. Policy is either Transient or Retained according to the client's request. The implementation may change Policy to instruct the server how to handle the message. For instance, it can set it Ignored in order to drop the message. The default implementation does not change Policy.

procedure Remove
          Server : in out MQTT_Server;
             Topic  : String
          );
procedure
Remove
          Server : in out MQTT_Server;
             Index  : Positive
          );

This procedure removes retained messages matched by the pattern Topic. E.g. if Topic is "#" all messages are removed. Note that this action does not influence messages already queued to the subscribers. They will be delivered even after being removed. The variant with the parameter Index removes the message by its number 1..Get_Messages_Number. Constraint_Error is propagated when Index is invalid.

procedure Set_Queue_Size
          (  Server : in out MQTT_Server;
             Size   : Positive
          );

This procedure sets the limit to the number of queued messages. Published messages are queued to be sent to a client. When the queue becomes full the connection is dropped. Setting the limit influences only future connections.

procedure Set_Tracing_Flags
          (  Server : in out MQTT_Server;
             Flags  : MQTT_Trace_Flags
          );

This procedure sets the server tracing flags.

Connection object.

type MQTT_Connection
     (  Server               : access MQTT_Server'Class;
        Listener             : access Connections_Server'Class;
        Input_Size           : Buffer_Length;
        Output_Size          : Buffer_Length;
        Max_Subscribe_Topics : Positive
     )  is new MQTT_Peer with private;

The type MQTT_Connection is a connection object that can be used as a server or a client with Connections_Server. The discriminant Server refers to an instance of MQTT_Server that to handle messages, subscriptions and sessions.

function Get_Name (Client : MQTT_Connection) return String;

This function returns the name of the session used by Client. The name is specified in the connect request. For an anonymous session the result is empty string.

[Back][TOC][Next]

17.16. SMTP

Simple Mail Transfer Protocol (SMTP) is a protocol used for exchange of electronic mail. The protocol is defined by RFC 821 and RFC 5321 standards. The provided implementation supports asynchronous sending mails. The application need not to wait for the client to connect and mails sent. Secure TLS connections are supported.

The package GNAT.Sockets.SMTP defines basic SMTP data types and operations on them:

SMTP_Port : constant := 25;

The default port used by SMTP is 25.

type SMTP_Command is
     (  SMTP_Greeting,
        ...
        SMTP_QUIT
     );

This type lists SMTP commands and generic states. E.g. SMTP_Greeting corresponds to the greeting line sent by the server upon client connection.

type SMTP_Extension is
     (  SMTP_8BITMIME,
        ...
        SMTP_XVRB
     );

This type lists SMTP extensions the server advertises to the client in response to the SMTP_EHLO command.

type SMTP_AUTH_Mechanism is mod 2**4;
SMTP_ANONYMOUS  : constant SMTP_AUTH_Mechanism := 0;
SMTP_PLAIN      : constant SMTP_AUTH_Mechanism := 2**0;
SMTP_LOGIN      : constant SMTP_AUTH_Mechanism := 2**1;
SMTP_CRAM_MD5   : constant SMTP_AUTH_Mechanism := 2**2;
SMTP_DIGEST_MD5 : constant SMTP_AUTH_Mechanism := 2**3;

This type specifies the methods of authentication. The more secure methods have greater values.

type Reply_Code is range 200..554;
function Image (Code : Reply_Code) return String;

This type defines the reply codes the server uses in its responses to the client. Codes 2xx indicate success.

function Text (Code : Reply_Code) return String;

This function returns a textual description of a reply code.

type Code_Class is
     (  Success,
        Persistent_Transient_Failure,
        Permanent_Failure
     );
type Code_Subject is range 0..999;
type Code_Detail  is range 0..999;

type Enhanced_Status_Code is record
   Class   : Code_Class;
   Subject : Code_Subject;
   Detail  : Code_Detail;
end record;
function Image (Code : Enhanced_Status_Code) return String;

This type declares the enhanced status code as defined in RFC 3463. Some servers provide extended status code in addition to the standard reply code.

function Text (Code    : Enhanced_Status_Code) return String;
function Text (Class   : Code_Class)           return String;
function Text (Subject : Code_Subject)         return String;

These functions return textual descriptions for the components of enhanced code.

type Error_Code (Enhanced : Boolean := False) is record
   Reply : Reply_Code;
   case Enhanced is
      when
True =>
         Error : Enhanced_Status_Code;
      when False =>
         null;
   end case;
end record;
function Image (Code : Error_Code) return String;

This type combines reply and enhanced status code into one value.

17.16.1. Mail address lists

The child package GNAT.Sockets.SMTP.Client provides the type Mail_Address_List:

type Mail_Address_List is tagged private;

The following operations are defined on the type:

procedure Add_Address
          (  List    : in out Mail_Address_List;
             Address : String
          );

This procedure adds an address to the list. Nothing happens when the address is already in the list or an empty string.

function Empty return Mail_Address_List;

This function returns an empty list.

function Find
         (  List    : Mail_Address_List;
            Address : String
         )  return Natural;

This function returns the position of address in the list or 0 when address is not in the list.

function From_String (List : String) return Mail_Address_List;

This function creates mail list from a string containing a comma-separated list of addresses.

function Get_Address
         (  List  : Mail_Address_List;
            Index : Positive
         )  return String;

This function returns address by its position. Contraint_Error is propagated when Index is invalid.

function Get_Length (List : Mail_Address_List) return Natural;

This function returns the number of addresses in the list.

function From_String (List : String) return Mail_Address_List;

This function creates mail list from a string containing a comma-separated list of addresses.

function Image (List : Mail_Address_List) return String;

This function returns a string containing comma-separated list of addresses.

function Is_Empty (List : Mail_Address_List) return Boolean;

This function returns true if the list is empty.

function Is_In
         (  List    : Mail_Address_List;
            Address : String
         )  return Boolean;

This function returns true if address is in the list.

procedure Remove
          (  List    : in out Mail_Address_List;
             Address : String
          );

This procedure removes address from the list.

procedure Remove
          (  List  : in out Mail_Address_List;
             Index : Positive
          );

This procedure removes address by its position. Constraint_Error is propagated when Index is invalid.

function "/" (Left, Right : String) return Mail_Address_List;

This function creates mail list consisting of the addresses Left and Right.

function "/"
         (  List    : Mail_Address_List;
            Address : String
         )  return Mail_Address_List;

This function returns a new list created by adding Address to List.

function "and" (Left, Right : Mail_Address_List)
   return Mail_Address_List;
function "or" (Left, Right : Mail_Address_List)
   return Mail_Address_List;
function "xor" (Left, Right : Mail_Address_List)
   return Mail_Address_List;

This functions provide set-theoretic operations on mail lists.

17.16.2. Mail objects

Objects of the type Mail defined in the package GNAT.Sockets.SMTP.Client contain mails to send:

type Mail is private;
type Mail_Array is array (Positive range <>) of Mail;

The instances of Mail have referential semantics. Therefore copying of Mail is shallow, when assigned both instances refer to the same mail. Thus any changes on one instance have the same effect on another. The following operations are defined on the type Mail:

procedure Attach_File
          (  Message      : in out Mail;
             Contents     : String;
             Content_Type : String := "text/plain";
             Disposition  : String := "";
             Description  : String := ""
          );
procedure Attach_Stream
          (  Message      : in out Mail;
             Contents     : access Root_Stream_Type'Class;
             Content_Type : String := "text/plain";
             Disposition  : String := "";
             Description  : String := ""
          );
procedure Attach_Stream
          (  Message      : in out Mail;
             Contents     : in out Root_Stream_Type'Class;
             Content_Type : String := "text/plain";
             Disposition  : String := "";
             Description  : String := ""
          );
procedure Attach_String
          (  Message      : in out Mail;
             Contents     : String;
             Content_Type : String := "text/plain";
             Disposition  : String := "";
             Description  : String := ""
          );

These procedures add contents to a mail. A mail must have at least one contents attached which serves a the mail body. When contents is attached using one of these procedures the mail will use MIME (Multipurpose Internet Mail Extensions), which also happens where the mail has several contents attached (attachments). The parameter Contents specifies the source of the contents. It may have the following forms:

The parameter Content_Type specifies the type of the content. The parameters Disposition and Description define the corresponding MIME headers to appear when not empty.

procedure Check (Message : Mail);

This procedure verifies if all mandatory parts of the message are set. Use_Error is propagated otherwise.

function Create
         (  From     : String;
            Subject  : String;
            To       : String / Mail_Address_List'Class;
            Cc       : Mail_Address_List'Class := Empty;
            Bcc      : Mail_Address_List'Class := Empty;
            Date     : Time := Clock
         )  return Mail;
function
Create
         (  From     : String;
            Subject  : String;
            To       : String / Mail_Address_List'Class;
            Contents : String;
            Cc       : Mail_Address_List'Class := Empty;
            Bcc      : Mail_Address_List'Class := Empty;
            Date     : Time   := Clock;
            MIME     : String := "text/plain"
         )  return Mail;

These functions create a new mail object. The parameter From specifies the sender's address. The parameter Subject is the mail subject. The parameter To can be plain string of a list mail addresses. When Contents is absent it must be added later using Attach_File, Attach_Stream or Attach_String. When Contents is String, MIME is empty string and there is no attachments the contents will be transferred without MIME. This can be used with legacy servers that do not support MIME. Parameters Cc and Bcc are lists of mail addresses. The parameter Date is the mail's time stamp. The parameter MIME specifies the content type. When not empty it forces MIME.

procedure Erase (Message : in out Mail);

This procedure cleans mail object up.

function Get
         (  Message : Mail;
            Header  : Text_Header
         )  return String;
function Get
         (  Message : Mail;
            Header  : List_Header
         )  return Mail_Address_List;
function Get
         (  Message : Mail;
            Header  : Date_Header
         )  return Time;

These functions return one of the mail headers. The headers are defined by the enumeration type:

type Mail_Header is
     (  Mail_From,
        Mail_Message_ID,
        Mail_In_Reply_To,
        Mail_Subject,
        Mail_MIME_Version,
        Mail_Content_Type,
        Mail_Precedence,
        Mail_References,
        Mail_Reply_To,
        Mail_Sender,
        Mail_Archived_At,
        Mail_To,
        Mail_Bcc,
        Mail_Cc,
        Mail_Date,
        Mail_Body -- Not used as a header, mail body introduction
     );

Some headers are set implicitly when a mail object is created. Other headers must be explicitly set if they must be appear in the mail. The headers are subdivided into string, mail address list and date subtypes:

subtype Text_Header is Mail_Header range Mail_From..Mail_Archived_At;
subtype List_Header is Mail_Header range Mail_To..Mail_Cc;
subtype Date_Header is Mail_Header range Mail_Date..Mail_Date;

Unset string headers are returned as empty strings. Unset address lists are empty. The following function returns textual representation of a header:

function Image (Header : Mail_Header) return String;

This function returns Header textual representation.

function Get_Status (Message : Mail) return Mail_Status;

These functions returns the mail status which is one of:

type Mail_Status is
     (  Mail_Pending,
        Mail_Sent,
        Mail_Rejected
     );

The status can be queried concurrently.

procedure Set
          (  Message : in out Mail;
             Header  : Text_Header;
             Text    : String
          );
procedure Set
          (  Message : in out Mail;
             Header  : List_Header;
             List    : Mail_Address_List'Class
          );
procedure Set
          (  Message : in out Mail;
             Header  : Date_Header;
             Date    : Time
           );

These procedures are used to set a mail header.

17.16.3. SMTP client implementation

The package GNAT.Sockets.SMTP.Client defines the SMTP client connection object type:

type SMTP_Client
     (  Listener     : access Connections_Server'Class;
        Input_Size   : Buffer_Length;
        Output_Size  : Buffer_Length;
        Reply_Length : Positive
     )  is new Connection with private;

The type is derived from Connection object. The dicriminants of the type are:

The client once connected starts posting mails queued by Send. Once there is no more mails to send it disconnects from the server. Therefore a typical procedure is:

  1. Create an SMTP_Client;
  2. Call Send to queue mails to send;
  3. Call Connect to initiate exchange.

The process of connection and sending mails is asynchronous to the caller. Once completed notification callbacks are called (Send_Abandoned, Send_Error, Send_Success) and the client object is collected if allowed (see management of connection objects). The following minimal example illustrates sending of a plain E-mail asynchronously:

   Factory : aliased Connections_Factory;
   Server  : aliased Connections_Server (Factory'Access, 0);
   Client  : Connection_Ptr :=
                new SMTP_Client
                    (  Listener     => Server'Unchecked_Access,
                       Reply_Length => 1024,
                       Input_Size   => 80,
                       Output_Size  => 1024
                    );
begin
   Set_Credentials (SMTP_Client (Client.all), "user", "password");
   Send
   (  SMTP_Client (Client.all),
      Create
      (  From     => "<test@localhost>",
         Subject  => "Sample",
         To       => "<smpt4dev@localhost>",
         Contents => "Hello all"
   )  );
   Connect (Server, Client, "127.0.0.1", SMTP_Port);

In this example one must ensure that the object Server is not prematurely destroyed before a connection is established and the mail is sent. Error handing is not shown as well. There are two methods to deal with errors:

For sending mail synchronously with waiting for completion see the package GNAT.Sockets.SMTP.Client.Synchronous.

Secure connections. The client support secure SSL/TLS connections. In order to be able to use such a connection the client must work with a secure connections server and a TLS factory, e.g. X509_Authentication_Factory. There are two methods how secure SMTP connection is established:

The opportunistic TLS has the advantage that it can work with both servers supporting and not supporting TLS.

The following primitive operations are additionally defined on SMTP_Client:

procedure Completed (Client : in out SMTP_Client);

This procedure is called when all mails are sent. An implementation may queue further mails to send. If it does not the client disconnects from the server. The default implementation does nothing.

function Get_Accepted
         (  Client : SMTP_Client
         )  return SMTP_AUTH_Mechanism;

This function returns the list of authentication methods the client is allowed to use. The method used is one with highest value among ones accepted and supported by the server. The list of accepted methods is set by calling Set_Credentials.

function Get_Authentication
         (  Client : SMTP_Client
         )  return SMTP_AUTH_Mechanism;

This function returns authentication method used by the client when called after the connection to the server was established.

function Get_Enhanced (Client : SMTP_Client) return Boolean;

This function returns true if the client attempts enhanced SMTP regardless the server greeting. See Set_Enhanced.

function Get_Extension
         (  Client    : SMTP_Client;
            Extension : SMTP_Extension
         )  return Boolean;

When the client is connected to the server the returned value indicates if the server announced the corresponding SMTP enhancement support in the greeting.

function Get_Mail_Size (Client : SMTP_Client) return Boolean;

This function returns the maximum mail size allowed by the server when called after  the connection to the server was established.

function Get_Password (Client : SMTP_Client) return String;

This function returns the password set by Set_Credentials.

function Get_TLS (Client : SMTP_Client) return Boolean;

This function returns true if the client will use secure TLS layer when offered by the server. See Set_TLS.

function Get_User (Client : SMTP_Client) return String;

This function returns the user name set by Set_Credentials.

procedure Send
          (  Client  : in out SMTP_Client;
             Message : Mail
          );
procedure
Send
          (  Client   : in out SMTP_Client;
             Messages : Mail_Array
          );

These procedures queue a message or messages to send.  The operation is completed with a call to Send_Abandoned, Send_Error, Send_Success with the mail in it. Usually the client is not yet connected when Send is called. Sendcan be called multiple times in order to send several mails. Use_Error is propagated when a message is invalid.

procedure Send_Abandoned
          (  Client   : in out SMTP_Client;
             Messages : Mail_Array
          );

This procedure is called to notify the client that some mails were abandoned, e.g. because the connection was dropped. The default implementation traces abandoned mails.

procedure Send_Error
          (  Client  : in out SMTP_Client;
             Code    : Error_Code;
             Context : SMTP_Command;
             Reply   : String
          );
procedure
Send_Error
          (  Client  : in out SMTP_Client;
             Code    : Error_Code;
             Context : SMTP_Command;
             Reply   : String;
             Message : Mail
          );

These procedures are called when the server responds with an error code indicating an unrecoverable error. Code is the responded code. The parameter Context specifies the failed command. Reply is the text provided by the server in its response. When Message is not given no attempt is made to recover. The connection is dropped. When Message is passed the error is limited to this message. The client will attempt to send other messages in the queue. The default implementation traces the error.

procedure Send_Success
          (  Client  : in out SMTP_Client;
             Message : Mail
          );

This procedure is called Message was accepted by the server. The default implementation does tracing.

procedure Set_Credentials
          (  Client   : in out SMTP_Client;
             User     : String;
             Password : String;
             Accepted : SMTP_AUTH_Mechanism :=
                        SMTP_AUTH_Mechanism'Last
          );

This procedure is called to set the user credentials (name and password) and the list authentication methods allowed to use. By default all methods are allowed and the one with the highest value offered by the server is used. When the server does not offer desired method the client tries to anonymous access. This also happens when the server does not support SMTP enhancements (see Set_Enhanced).

procedure Set_Enhanced
          (  Client   : in out SMTP_Client;
             Enhanced : Boolean
          );

Normally the client uses enhanced mode when the server greets it with a line containing the word ESMTP, which by convention indicates that the server supports enhanced SMPT. When the server does not advertise ESMTP but nonetheless it is known to support it this procedure can be called with the parameter Enhanced set to true in order to use enhanced SMTP anyway. This procedure has the effect only when the client is not yet connected to the server.

procedure Set_TLS
          (  Client : in out SMTP_Client;
             Enable : Boolean
          );

This procedure can be used to prevent the client to use secure TLS layer when offered by the server. For this Enable must be set to false. See the description of secure SMTP connections. This procedure has the effect only when the client is not yet connected to the server.

17.16.4. SMTP synchronous client implementation

The package GNAT.Sockets.SMTP.Client.Synchronous provides a simplified way to send E-mail:

procedure Send
          (  Server   : in out Connections_Server;
             Host     : String;
             Message  : Mail;
             User     : String;
             Password : String;
             Accepted : SMTP_AUTH_Mechanism :=
                        SMTP_AUTH_Mechanism'Last;
             Port     : Port_Type := SMTP_Port;
             Timeout  : Duration  := Duration'Last
          );

This procedure sends mail synchronously. The procedure awaits for connection to the server and completion of sending. The parameter Timeout specifies the operation timeout.

Exceptions
Constraint_Error Timeout is expired
Data_Error Mail sending error
Host_Error Invalid host name
Socket_Error I/O error, connection is dropped
Use_Error Invalid mail

The following example illustrates usage:

   Factory : aliased Connections_Factory;
   Server  : aliased Connections_Server (Factory'Access, 0);
begin
    Send
    (  Server  => Server,
       Host    => "127.0.0.1",
       Message => Create
                  (  From     => "<test@localhost>",
                     Subject  => "Hi!",
                     To       => "<smpt4dev@localhost>",
                     Contents => "Hello all"
                  ),
      User     => "User",
      Password => "Password",
      Timeout  => 10.0
   );

[Back][TOC][Next]

17.17. NTP

Network Time Protocol (NTP) is a protocol used for computer clock synchronization and time exchange. The protocol is defined by RFC 5905 standards. The package GNAT.Sockets.NTP implements basic NTP time query. The following subprograms are defined in the package:

function Get_Time
         (  Server  : String;
            Timeout : Timeval_Duration := 10.0;
            Adjust  : Boolean := True
         )  return Time;

This function queries current time from the NTP server specified by the parameter String, which can be host name or IP address. Timeout is the operation timeout. The result is UTC.  If local time is required it can be obtained this way:

Get_Time ("time.nist.gov") + Duration (UTC_Time_Offset) * 60.0)

When parameter Adjust is true one half of roundtrip is subtracted from the resulting time in order to compensate transmission delay.

[Back][TOC][Next]

17.18. ASN.1

Abstract Syntax Notation One (ASN.1) is a data definition language and encoding description used by some network protocols as well as file formats. The packages rooted in GNAT.Sockets.Connection_State_Machine.ASN1 provide means to encode and decode Ada objects into and from ASN.1 No ASN.1 parser or compiler is required. The ASN.1 encoding is deduced directly from the structure of the corresponding Ada type. For example, the following Ada declaration:

type Name_And_Check is
   new
ASN1.Sequences.Sequence_Data_Item with
record

   Name  : ASN1.Strings.String_Data_Item (200);
   Check : ASN1.Booleans.Boolean_Data_Item;
   Date  : ASN1.Dates.Generalized_Time_Data_Item;
end record;

is equivalent to ASN.1 declaration

Name_And_Check ::= SEQUENCE
                   {  Name  STRING,
                      Check BOOLEAN,
                      Date  TIME
                   }

Such declarations can be put into a state machine connection object so that they will be automatically filled with the actual values upon reading from the socket or encoded when writing the socket. The package GNAT.Sockets.Connection_State_Machine.ASN1 has the following declarations:

type ASN1_Tag is new Stream_Element;
type ASN1_Type is new Integer;

The type ASN1_Tag represents ASN.1 tags. The tag may contain a predefined ASN.1 type in its 5 lower-order bits. Types that are greater than 30 and do not fit into the tag are encoded in the octets following the tag. The predefined ASN.1 types are:

Boolean_Tag           : constant ASN1_Type := 1;
Integer_Tag           : constant ASN1_Type := 2;
Bit_String_Tag        : constant ASN1_Type := 3;
Octet_String_Tag      : constant ASN1_Type := 4;
Null_Tag              : constant ASN1_Type := 5;
Object_Identifier_Tag : constant ASN1_Type := 6;
Object_Descriptor_Tag : constant ASN1_Type := 7;
Instance_Tag          : constant ASN1_Type := 8;  -- External
Real_Tag              : constant ASN1_Type := 9;
Enumerated_Tag        : constant ASN1_Type := 10;
Embedded_Tag          : constant ASN1_Type := 11;
UTF8_String_Tag       : constant ASN1_Type := 12;
Relative_OID_Tag      : constant ASN1_Type := 13;
Time_Tag              : constant ASN1_Type := 14;
Sequence_Tag          : constant ASN1_Type := 16;
Set_Tag               : constant ASN1_Type := 17;
Numeric_String_Tag    : constant ASN1_Type := 18;
Printable_String_Tag  : constant ASN1_Type := 19;
Teletext_String_Tag   : constant ASN1_Type := 20; -- T61String
Videotext_String_Tag  : constant ASN1_Type := 21;
IA5_String_Tag        : constant ASN1_Type := 22;
UTC_Time_Tag          : constant ASN1_Type := 23;
Generalized_Time_Tag  : constant ASN1_Type := 24;
Graphic_String_Tag    : constant ASN1_Type := 25;
ISO646_String_Tag     : constant ASN1_Type := 26; -- VisibleString
General_String_Tag    : constant ASN1_Type := 27;
Universal_String_Tag  : constant ASN1_Type := 28;
Character_String_Tag  : constant ASN1_Type := 29;
BMP_String_Tag        : constant ASN1_Type := 30;
Date_Tag              : constant ASN1_Type := 31;
Time_Of_Day_Tag       : constant ASN1_Type := 32;
Date_Time_Tag         : constant ASN1_Type := 33;
Duration_Tag          : constant ASN1_Type := 34;

function Image (Tag : ASN1_Type) return String;

This function represents a predefined ASN.1 type in human-readable form.

Some objects can be constructed out of multiple objects. The bit 6 of the tag indicates a constructed object value:

Constructed : constant ASN1_Tag := 2#0010_0000#;

Higher-order bits indicate the class of the tag:

Universal_Class        : constant ASN1_Tag := 2#0000_0000#;
Application_Class      : constant ASN1_Tag := 2#0100_0000#;
Context_Specific_Class : constant ASN1_Tag := 2#1000_0000#;
Private_Class          : constant ASN1_Tag := 2#1100_0000#;

The class indicates the meaning of the tag value:

Normally tag values are used in order to distinguish values of same types in a container object. Another purpose is to recognize presence or absence of an optional object in a container.

type Abstract_ASN1_Data_Item is
   abstract new
Data_Item with null record;
type Abstract_ASN1_Data_Item_Ptr is
   access all
Abstract_ASN1_Data_Item'Class;

All data items representing ASN.1 objects are descendants of the base type Abstract_ASN1_Data_Item. The following primitive operations are defined on the type:

function Always_Constructed
         (  Item : Abstract_ASN1_Data_Item
         )  return Boolean is abstract;

This function returns true if the objects of the type are always constructed.

procedure Encode
          (  Item    : Abstract_ASN1_Data_Item;
             Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset
          )  is abstract;

This procedure places an encoded representation of the object Item into the buffer Data starting at the position specified by Pointer. In all cases the definite length form is used as recommended by ASN.1 distinguished encoding rules (DER). After successful completion Pointer is advanced to the position following the output.

Exceptions
End_Error No room for output
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1
Status_Error The object is not initialized yet

function Is_Implicit
         (  Item : Abstract_ASN1_Data_Item
         )  return Boolean is abstract;

This function returns true if the has implicit type and length encoding. The ASN.1 object type and length can be present (explicit) or absent (implicit) in the encoding. When no type and length are specified they are determined by the position or by the tag. In both cases it is the responsibility of the container object to pass this information to the contained object's Feed using Set_Implicit_Tag.

procedure Set_Implicit_Tag
          (  Item   : in out Abstract_ASN1_Data_Item;
             Tag    : Tag_Type;
             Length : Stream_Element_Offset
          );

This procedure must be called before using Feed on an object which does not have the type and length explicitly encoded. It supplies it the missing information about the encoding length and the tag value. The latter is normally not used because the type of the object is known beforehand. Though it can be checked. The parameter Length specifies the encoding length. When negative the encoding is indefinite. Only a few ASN.1 object support indefinite length encoding. When Length is zero, the object's implementation should not expect Feed to be called, because it is never called with no data to process. The default implementation checks if the encoding is definite. Data_Error is propagated when Length is invalid.

procedure Set_Untagged (Item : in out Abstract_ASN1_Data_Item);

This procedure is called before using Feed to inform that there is no tag. Most implicit objects cannot be input without tag because the length is not specified. The default implementation fails if the object is implicit. See also Set_Implicit_Tag.

type ASN1_Data_Item is
   abstract new
Abstract_ASN1_Data_Item with null record;

This is the base type of all data items representing ASN.1 objects having a type. Most ASN1.1 object do. An exception is ASN.1 choice which has no type.

function Get_ASN1_Type
         (  Item : ASN1_Data_Item
         )  return ASN1_Type is abstract;

This function returns the ASN.1 type.

ASN.1 tags. The package GNAT.Sockets.Connection_State_Machine.ASN1 declares the types to handle ASN.1 tags:

type Tagging_Type is
     (  Application_Tag,
        Context_Specific_Tag,
        Private_Tag,
        Universal_Tag
     );

This enumeration type specifies one of the four tag classes. The universal tag has the ASN.1 type as its value and is equivalent to type specification.

type Tag_Type is record
   Class    : Tagging_Type := Universal_Tag;
   Value    : ASN1_Type    := 0;
   Optional : Boolean      := False;
end record;

This type describes a tag. The components are:

The following operations are defined on tags:

function "=" (Left, Right : Tag_Type) return Boolean;
function "<" (Left, Right : Tag_Type) return Boolean;

The tags are ordered first by the class and then by the value. The component Optional is ignored.

function Image (Value : Tag_Type) return String;

This function returns a text representation of a tag. E.g. application tag 20 is represented as [APPLICATION 20].

ASN.1 tag encoding. The following procedures are used for direct decoding and encoding of tags:

procedure Get
          (  Data        : Stream_Element_Array;
             Pointer     : in out Stream_Element_Offset;
             Tag         : out Tag_Type;
             Constructed : out Boolean
          );

This procedure takes an encoded representation of a tag from Data starting at the position specified by Pointer. After successful completion Pointer is advanced to the position following the input. The tag is placed into Tag. The parameter Constructed is set to true if the tag has the constructed bit set.

Exceptions
Constraint_Error The tag is too large
Data_Error Invalid tag
End_Error Not enough data. The sequence in Data is incomplete
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

procedure Put
          (  Data        : in out Stream_Element_Array;
             Pointer     : in out Stream_Element_Offset;
             Tag         : Tag_Type;
             Constructed : Boolean
          );

This procedure puts an encoded representation of Tag into Data starting at the position specified by Pointer. After successful completion Pointer is advanced to the position following the output. The parameter Constructed is set to true if the tag must have the constructed bit set.

Exceptions
End_Error No room for output
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

List objects

type ASN1_List_Data_Item is
   abstract new
ASN1_Data_Item with private;

This type is the abstract base of all types implementing ASN.1 sequences and sets. The following abstract primitive operations must be implemented:

function Get_Length
         (  Item : ASN1_List_Data_Item
         )  return Natural is abstract;

This function returns the number of elements in the sequence. Use_Error is propagated when Item was not initialized yet.

List objects of tagged elements

type ASN1_Tagged_List_Data_Item is
   abstract new
ASN1_List_Data_Item with private;

This type is the abstract base of all types implementing ASN.1 sequences and sets which have tagged elements. The following abstract primitive operations must be implemented:

function Get_Tag
         (  Item  : ASN1_Tagged_List_Data_Item;
            Index : Positive
         )  return Tag_Type is abstract;

This functions returns the tag of the element specified by its index 1..Get_Length in the list.

Exceptions
Constraint_Error The index is out of range 1..Get_Length or else the element is untagged
Use_Error The sequence was not initialized yet

function Is_Set
         (  Item  : ASN1_Tagged_List_Data_Item;
            Index : Positive
         )  return Boolean is abstract;

This function returns the true if the element was set. If the list allows optional elements then this function allows to determine if the element is present. For instance the element is not set when it is optional and absent in the input. The element is specified by its index in the range 1..Get_Length.

Exceptions
Constraint_Error The index is out of range 1..Get_Length
Use_Error The sequence was not initialized yet

function Is_Untagged
         (  Item  : ASN1_Tagged_List_Data_Item;
            Index : Positive
         )  return Boolean is abstract;

This function returns the true if the element has no tag. The element is specified by its index in the range 1..Get_Length.

17.18.1. Bit string

The package GNAT.Sockets.Connection_State_Machine.ASN1.Bit_Strings provides the root package of ASN.1 BIT STRING implementations:

type Boolean_Array is array (Integer range <>) of Boolean;

Bit string base objects

type Public_Bit_String_Data_Item (Size : Natural) is
   abstract new
ASN1_Data_Item with
record

   Length : Natural := 0; -- The actual length of the value
   Value  : Boolean_Array (1..Size);
end record;

This is the common part of the types:

function Get_Length
         (  Item : Public_Bit_String_Data_Item
         )  return Natural;

This is a convenience function to get the actual value length.

function Get_Value
         (  Item : Public_Bit_String_Data_Item
         )  return Boolean_Array;

This is a convenience function to get the actual value.

procedure Set_Value
          (  Item  : in out Public_Bit_String_Data_Item;
             Value : Boolean_Array
          );

This is a convenience procedure to set the value. Constraint_Error is propagated when the value is too large.

Direct encoding. The following procedures are used for direct decoding and encoding Ada value type:

procedure Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : out Boolean_Array
          );

This procedure takes an encoded representation of BIT STRING from Data starting at the position specified by Pointer. The representation is implicit, the ASN.1 type and length are not used. The length is determined by the bit array length assuming 8 bits per stream element and one header element. The header element is the number 0..7 of unused bits in the last element. Thus if the length of encoding is n and the first element is k, then the number of bits is n·8 - k. After successful completion Pointer is advanced to the position following the input. The result is placed into Value.

Exceptions
Data_Error Invalid encoding
End_Error Not enough data. The sequence in Data is incomplete
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

procedure Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Boolean_Array
          );

This procedure puts an encoded representation of BIT STRING into Data starting at the position specified by Pointer. The representation is implicit, the ASN.1 type and length are not used. After successful completion Pointer is advanced to the position following the output.

Exceptions
End_Error No room for output
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

Bit string objects. The implicit representation is provided by the child package Implicit:

type Implicit_Bit_String_Data_Item is
   new
Public_Bit_String_Data_Item with private;

The explicit representation is provided by the child package Explicit:

type Bit_String_Data_Item is
   new
Implicit_Bit_String_Data_Item with null record;

External bit string objects. The bit strings can be allocated in an external string buffer. The implicit representation is provided by the child package Implicit:

type Implicit_External_Bit_String_Data_Item is
   new
ASN1_Data_Item with private;

The type's additional operations are:

function Get_Buffer
         (  Item : Implicit_External_Bit_String_Data_Item
         )  return External_String_Buffer_Ptr;

These functions return the external buffer used.

function Get_Length
         (  Item : Implicit_External_Bit_String_Data_Item
         )  return Natural;

These functions return the actual value length.

function Get_Value
         (  Item : Implicit_External_Bit_String_Data_Item
         )  return Boolean_Array;

These functions return the actual value.

procedure Set_Value
          (  Item  : in out Implicit_External_Bit_String_Data_Item;
             Value : Boolean_Array
          );

These procedures set the value.

Exceptions
Constraint_Error No room to store the value
Use_Error Item was not initialized yet

The explicit representation is provided by the child package Explicit:

type External_Bit_String_Data_Item is
   new
Implicit_External_Bit_String_Data_Item with null record;

17.18.2. Boolean

The package GNAT.Sockets.Connection_State_Machine.ASN1.Booleans provides an implementation of ASN.1 BOOLEAN.

Boolean objects

type Implicit_Boolean_Data_Item is new ASN1_Data_Item with record
   Value : Boolean;
end record;
type Boolean_Data_Item is
   new
Implicit_Boolean_Data_Item with null record;

These types implement implicitly and explicitly encoded BOOLEAN.

function Get_Value
         (  Item : Implicit_Boolean_Data_Item
         )  return Boolean;

This is a convenience function to get the actual value.

procedure Set_Value
          (  Item  : in out Implicit_Boolean_Data_Item;
             Value : Boolean
          );

This is a convenience function to set the actual value.

Direct encoding. The following procedures are used for direct decoding and encoding Boolean:

procedure Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : out Boolean
          );

This procedure takes an encoded representation of BOOLEAN from Data starting at the position specified by Pointer. The representation is implicit, the ASN.1 type and length are not used. After successful completion Pointer is advanced to the position following the input. The result is placed into Value.

Exceptions
End_Error Not enough data. The sequence in Data is incomplete
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

procedure Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Boolean
          );

This procedure puts an encoded representation of BOOLEAN into Data starting at the position specified by Pointer. The representation is implicit. After successful completion Pointer is advanced to the position following the output.

Exceptions
End_Error No room for output
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

17.18.3. Choice

The package GNAT.Sockets.Connection_State_Machine.ASN1.Choices provides an implementation of ASN.1 CHOICE.

type Choice_Data_Item is new Abstract_ASN1_Data_Item with private;

A choice contains any number of alternatives, other ASN.1 objects. The input determines the alternative by its tag. The output uses the selected alternative for encoding. The choice object has no ASN.1 type. It is not a proper ASN.1 object. An alternative of choice cannot be another choice. The data type Choice_Data_Item implements an empty choice. A non-empty choice is declared  by deriving a new type from it and placing items derived from ASN1_Data_Item into it. For example:

type Alternatives_Record is new Choice_Data_Item with record
   Name : Implicit_String_Data_Item (20);
   ID   : Implicit_Integer_Data_Item;
end record;

This is equivalent to ASN.1:

CHOICE
{  Name [0] IMPLICIT OCTET STRING,
   ID   [1] IMPLICIT INTEGER
}

By default all alternatives get context-specific tags assigned in ascending order.  The tags can be changed. Note that universally tagged alternatives in the choice must be implicit because the universal tag already contains the object type.

procedure Enable_Unsolicited
          (  Item     : in out Choice_Data_Item;
             Enable   : Boolean;
             Implicit : Boolean := False
          );

By default when an unknown tag appears, it is treated as an error. If Enable is set to true, the tagged object is skipped and Get_Selected will return 0 or null. The parameter Implicit when set to true indicates that the potentially skipped objects are implicit (have no ASN.1 type). This has no effect if the skipped object has universal tag. Use_Error is propagated when Item was not initialized yet.

function Get_Children
         (  Item : Choice_Data_Item
         )  return Data_Item_Ptr_Array;

This function is an overriding of the primitive operation of Data_Item that returns the alternatives. Use_Error is propagated when Item was not initialized yet.

function Get_Length
         (  Item : Choice_Data_Item
         )  return Natural;

This function returns the number of alternatives. Use_Error is propagated when Item was not initialized yet.

function Get_Selected
         (  Item : Choice_Data_Item
         )  return Natural;
function Get_Selected
         (  Item : Choice_Data_Item
         )  return Abstract_ASN1_Data_Item;

This function return the index of or pointer to the alternative or 0 or null if none selected. Use_Error is propagated when Item was not initialized yet.

function Get_Tag
         (  Item  : Choice_Data_Item;
            Index : Positive
         )  return Tag_Type;

This function returns the tag associated with alternative. The alternative is specified by its index in the range 1..Get_Length.

Exceptions
Constraint_Error Index is not in the range 1..Get_Length
Use_Error The object Item is not initialized yet

procedure Initialized (Item : in out Choice_Data_Item);

This procedure is called when all components of the object have been enumerated, so that some additional initialization could be finished with all components known. The default implementation does nothing.

function Is_Unsolicited_Enabled
         (  Item : Choice_Data_Item
         )  return Boolean;

This function returns true if a choice containing an object tagged by unknown tag can be ignored. See Enable_Unsolicited.

function Is_Unsolicited_Implicit
         (  Item  : Choice_Data_Item
         )  return Boolean;

This function returns true if objects tagged by unknown tags have implicit ASN.1 type. See Enable_Unsolicited.

procedure Set_External_Tag
          (  Item : in out Choice_Data_Item;
             Tag  : Tag_Type
          );

This procedure changes the behavior of Feed to use the specified tag instead of taking it from the input. This is the case when the tag has been already obtained by the container item. See also Set_Internal_Tag.

procedure Set_Internal_Tag
          (  Item : in out Choice_Data_Item
          );

This procedure changes the behavior of Feed to parse the tag and then select the alternative accordingly. This is the default behavior. See also Set_External_Tag.

procedure Set_Selected
          (  Item  : in out Choice_Data_Item;
             Index : Positive
          );

This procedure sets the selected alternative. The alternative is specified by its index in the range 1..Get_Length.

Exceptions
Constraint_Error Index is not in the range 1..Get_Length
Use_Error The object Item is not initialized yet

procedure Set_Tag
          (  Item  : in out Choice_Data_Item;
             Index : Positive;
             Tag   : Tag_Type
          );

This procedure changes the alternative's tag. By default the tags are assigned context-specific in ascending order starting from 0. When tag is universal the corresponding object must be implicit otherwise Mode_Error is propagated. It is also propagated when the tag value of universal tag differs from the object's ASN.1 type or when the tag does not indicate optional choice (all choice alternatives must be optional). The alternative is specified by its index in the range 1..Get_Length.

Exceptions
Constraint_Error Index is not in the range 1..Get_Length
Mode_Error Wrongly tagged object
Use_Error The object Item is not initialized yet

17.18.4. Date

The package GNAT.Sockets.Connection_State_Machine.ASN1.Dates provides an implementation of ASN.1 date and time types.

Date objects

type Public_Time_Data_Item is abstract new ASN1_Data_Item with record
   Value : Time;
end record;

This is the public view of all ASN.1 date objects.

function Get_Time
         (  Item : Public_Time_Data_Item
         )  return Time;

This is a convenience function to get the actual value.

procedure Set_Value
          (  Item  : in out Public_Time_Data_Item;
             Value : Time
          );

This is a convenience function to set the actual value.

type Generalized_Time_Data_Item is
   new
Public_Time_Data_Item with private;
type Implicit_Generalized_Time_Data_Item is
   new
Public_Time_Data_Item with private;

These two types implement explicit and implicit ASN.1 generalized time.

type UTC_Time_Data_Item is
   new
Public_Time_Data_Item with private;
type Implicit_UTC_Time_Data_Item is
   new
Public_Time_Data_Item with private;

These types implement explicit and implicit ASN.1 UTC time.

Day time objects

type Public_Duration_Data_Item is abstract new ASN1_Data_Item with record
   Value : Day_Duration;
end record;

This is the public view of all ASN.1 time objects.

function Get_Duration
         (  Item : Public_Duration_Data_Item
         )  return Time;

This is a convenience function to get the actual value.

procedure Set_Duration
          (  Item  : in out Public_Duration_Data_Item;
             Value : Day_Duration
          );

This is a convenience function to set the actual value.

type Implicit_Time_Data_Item is
   new
Public_Duration_Data_Item with private;
type Time_Data_Item is
   new
Public_Duration_Data_Item with private;

These types implement implicit and explicit  ASN.1 time.

Direct encoding. The following procedures are used for direct decoding and encoding date and time:

procedure Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Length  : Stream_Element_Offset;
             Value   : out Time
          );

This procedure takes an encoded representation of date from Data starting at the position specified by Pointer. The representation is implicit, the ASN.1 type and length are not used. Length specifies the encoding length. After successful completion Pointer is advanced to the position following the input. The result is placed into Value.

Exceptions
End_Error Not enough data. The sequence in Data is incomplete
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1
Time_Error Invalid time

procedure Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Length  : Stream_Element_Offset;
             Value   : out Day_Duration
          );

This procedure takes an encoded representation of day time from Data starting at the position specified by Pointer. The representation is implicit, the ASN.1 type and length are not used. Length specifies the encoding length. After successful completion Pointer is advanced to the position following the input. The result is placed into Value.

Exceptions
End_Error Not enough data. The sequence in Data is incomplete
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1
Time_Error Invalid time

procedure Get_UTC
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Length  : Stream_Element_Offset;
             Value   : out Time
          );

This procedure takes an encoded representation of date in ASN.1 UTC time format from Data starting at the position specified by Pointer. The representation is implicit, the ASN.1 type and length are not used. Length specifies the encoding length. After successful completion Pointer is advanced to the position following the input. The result is placed into Value.

Exceptions
End_Error Not enough data. The sequence in Data is incomplete
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1
Time_Error Invalid time

procedure Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Time
          );

This procedure puts an encoded date into Data starting at the position specified by Pointer. The representation is implicit, the ASN.1 type is not used. After successful completion Pointer is advanced to the position following the output.

Exceptions
End_Error No room for output
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

procedure Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Day_Duration
          );

This procedure puts an encoded day time into Data starting at the position specified by Pointer. The representation is implicit, the ASN.1 type is not used. After successful completion Pointer is advanced to the position following the output.

Exceptions
End_Error No room for output
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

procedure Put_UTC
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Time
          );

This procedure puts an encoded date into Data starting at the position specified by Pointer in ASN.1 UTC format. The representation is implicit, the ASN.1 type is not used. After successful completion Pointer is advanced to the position following the output.

Exceptions
End_Error No room for output
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

17.18.5. Distinguished name

The package GNAT.Sockets.Connection_State_Machine.ASN1.Distinguished_Names provides an implementation of ASN.1 string that contains a distinguished name.

Distinguished name objects

type DN_Data_Item is
   new
String_Data_Item with private;
type Implicit_DN_Data_Item is
   new
Implicit_String_Data_Item with private;

The distinguished name object is implemented by an ASN.1 string. The string value is interpreted as a sting representation of the distinguished name. There is no ASN.1 type for distinguished name. The type is the type of the string. If it must be different from UTF-8, then Get_ASN1_Type can be overridden to return another string type, e.g. of an octet string.

function Get_Name
         (  Item : DN_Data_Item
         )  return Distinguished_Name;
function Get_Name
         (  Item : Implicit_DN_Data_Item
         )  return Distinguished_Name;

These functions return the object's string value as a distinguished name.

Exceptions
End_Error No name stored in the string
Data_Error The stored distinguished name is invalid

procedure Set_Name
          (  Item : in out DN_Data_Item;
             Name : Distinguished_Name
          );
procedure Set_Name
          (  Item : in out Implicit_DN_Data_Item;
             Name : Distinguished_Name
          );

These procedures set the distinguished name into the object. Constraint_Error is propagated when the name is too large to store.

External distinguished name objects

type External_DN_Data_Item is
   new
External_String_Data_Item with private;
type Implicit_External_DN_Data_Item is
   new
Implicit_External_String_Data_Item with private;

These types use an an external string buffer to keep the string representing the distinguished name.

function Get_Name
         (  Item : External_DN_Data_Item
         )  return Distinguished_Name;
function Get_Name
         (  Item : Implicit_External_DN_Data_Item
         )  return Distinguished_Name;

These functions return the object's string value as a distinguished name.

Exceptions
End_Error No name stored in the string
Data_Error The stored distinguished name is invalid

procedure Set_Name
          (  Item : in out External_DN_Data_Item;
             Name : Distinguished_Name
          );
procedure Set_Name
          (  Item : in out Implicit_External_DN_Data_Item;
             Name : Distinguished_Name
          );

Direct encoding. These procedures set the distinguished name into the object.

Exceptions
Storage_Error No room to store the value
Use_Error Item was not initialized yet

The following procedures are used for direct decoding and encoding distinguished names:

function Get
         (  Data    : Stream_Element_Array;
            Pointer : access Stream_Element_Offset;
            Length
  : Stream_Element_Offset
         )  return Distinguished_Name;

This procedure takes a string-encoded distinguished from Data starting at the position specified by Pointer. The representation is implicit, the ASN.1 type and length are not used. Length is the encoding length. After successful completion Pointer is advanced to the position following the input. The result is placed into Value.

Exceptions
Data_Error Syntax error
End_Error Not enough data. The sequence in Data is incomplete
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

procedure Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Name    : Distinguished_Name
          );

This procedure puts a distinguished name as a string into Data starting at the position specified by Pointer. The representation is implicit, the ASN.1 type and length are not used. After successful completion Pointer is advanced to the position following the output.

Exceptions
End_Error No room for output
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

17.18.6. Enumerated

The package GNAT.Sockets.Connection_State_Machine.ASN1.Generic_Enumeration provides an implementation of ASN.1 ENUMERATED:

generic
   type
Enumeration is (<>);
package GNAT.Sockets.Connection_State_Machine.ASN1.
        Generic_Enumeration is ...

The package is generic. The generic formal parameter Enumeration is the enumeration type.

type Public_Enumeration_Data_Item is
   abstract new ASN1_Data_Item with
record

   Value : Enumeration;
end record;

This is the public base type used with actual implementations.

function Get_Value
         (  Item : Public_Enumeration_Data_Item
         )  return Enumeration;

This is a convenience function to get the actual value.

procedure Set_Value
          (  Item  : in out Public_Enumeration_Data_Item;
             Value : Enumeration
          );

This is a convenience function to set the actual value.

type Implicit_Enumeration_Data_Item is
   new
Public_Enumeration_Data_Item with private;
type Enumeration_Data_Item is
   new
Public_Enumeration_Data_Item with private;

These types implement implicitly and explicitly encoded ENUMERATION.

Direct encoding. The following procedures are used for direct decoding and encoding:

procedure Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Length
 : Stream_Element_Offset; 
             Value   : out Enumeration
          );

This procedure takes an encoded representation of ENUMERATED from Data starting at the position specified by Pointer. The representation is implicit, the ASN.1 type and length are not used. Length specifies the encoding length. After successful completion Pointer is advanced to the position following the input. The result is placed into Value.

Exceptions
Data_Error The value is too large
End_Error Not enough data. The sequence in Data is incomplete
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

procedure Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Enumeration
          );

This procedure puts an encoded representation of ENUMERATED into Data starting at the position specified by Pointer. The representation is implicit, the ASN.1 type and length are not used. After successful completion Pointer is advanced to the position following the output.

Exceptions
End_Error No room for output
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

17.18.7. Integer

There are several packages implementing ASN.1 INTEGER:

The package GNAT.Sockets.Connection_State_Machine.ASN1.Generic_Integer is a generic package instantiated with an integer type:

generic
   type
Number is range (<>);
package GNAT.Sockets.Connection_State_Machine.ASN1.Generic_Integer is ...

The package declares the types:

type Implicit_Integer_Data_Item is new ASN1_Data_Item with record
   Value : Number;
end record;
type Integer_Data_Item is
   new
Implicit_Integer_Data_Item with null record;

These types implement implicitly and explicitly encoded INTEGER.

function Get_Value
         (  Item : Implicit_Integer_Data_Item
         )  return Number;

This is a convenience function to get the actual value.

procedure Set_Value
          (  Item  : in out Implicit_Integer_Data_Item;
             Value : Number
          );

This is a convenience function to set the actual value.

Direct encoding. The following procedures are used for direct decoding and encoding:

procedure Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Length  : Stream_Element_Count;
             Value   : out Number
          );

This procedure takes an encoded representation of ENUMERATED from Data starting at the position specified by Pointer. The representation is implicit, the ASN.1 type and length are not used. The actual Length of encoding is specified by the parameter Length. After successful completion Pointer is advanced to the position (+Length) following the input. The result is placed into Value.

Exceptions
Constraint_Error The value is too large
End_Error Not enough data. The sequence in Data is incomplete
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

procedure Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Number
          );

This procedure puts an encoded representation of ENUMERATED into Data starting at the position specified by Pointer. The representation is implicit, the ASN.1 type and length are not used. After successful completion Pointer is advanced to the position following the output.

Exceptions
End_Error No room for output
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

The package GNAT.Sockets.Connection_State_Machine.ASN1.Generic_Unsigned is a generic package instantiated with an integer type:

generic
   type
Number is mod (<>);
package GNAT.Sockets.Connection_State_Machine.ASN1.
        Generic_Unsigned is ...

The package declares the types:

type Implicit_Unsigned_Data_Item is new ASN1_Data_Item with record
   Value : Number;
end record;
type Unsigned_Data_Item is
   new
Implicit_Integer_Data_Item with null record;

These types implement implicitly and explicitly encoded INTEGER.

function Get_Value
         (  Item : Implicit_Unsigned_Data_Item
         )  return Number;

This is a convenience function to get the actual value.

procedure Set_Value
          (  Item  : in out Implicit_Unsigned_Data_Item;
             Value : Number
          );

This is a convenience function to set the actual value.

Direct encoding. The following procedures are used for direct decoding and encoding:

procedure Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : out Number
          );

This procedure takes an encoded representation of ENUMERATED from Data starting at the position specified by Pointer. The representation is implicit, the ASN.1 type and length are not used. After successful completion Pointer is advanced to the position following the input. The result is placed into Value.

Exceptions
Constraint_Error The value is too large
End_Error Not enough data. The sequence in Data is incomplete
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

procedure Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Number
          );

This procedure puts an encoded representation of ENUMERATED into Data starting at the position specified by Pointer. The representation is implicit, the ASN.1 type and length are not used. After successful completion Pointer is advanced to the position following the output.

Exceptions
End_Error No room for output
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

The package GNAT.Sockets.Connection_State_Machine.ASN1.Indefinite_Unsigneds is provides indefinite length unsigned integers. The integer is kept in a Stream_Element_Array encoded big-endian. Let (e1, e2, ... ,en) be a sequence of stream elements. Then the corresponding value is:

v = e1·28·(n-1) + e2·28·(n-2) + ... + en-1·28 + en

The value is allocated in an external string buffer. The package declares the types:

type Implicit_Indefinite_Unsigned_Data_Item is
   new
ASN1_Data_Item with
record
   Buffer : External_String_Buffer_Ptr;
   Start  : Positive := 1;
   Length : Natural  := 0;
end record
;
type Indefinite_Unsigned_Data_Item is
   new
Implicit_Indefinite_Unsigned_Data_Item with null record;

This type implement implicitly encoded INTEGER.

function Get_Buffer
         (  Item : Implicit_Indefinite_Unsigned_Data_Item
         )  return External_String_Buffer_Ptr;

These functions return the external buffer used.

function Get_Length
         (  Item : Implicit_Indefinite_Unsigned_Data_Item
         )  return Natural;

These functions return the actual value length in stream elements.

function Get_Value
         (  Item : Implicit_Indefinite_Unsigned_Data_Item
         )  return Stream_Element_Array;

These functions return the actual value. The value is encoded big-endian.

procedure Set_Value
          (  Item  : in out Implicit_Indefinite_Unsigned_Data_Item;
             Value : Stream_Element_Array
          );

These procedures set the value.

Exceptions
Storage_Error No room to store the value
Use_Error Item was not initialized yet

type Indefinite_Unsigned_Data_Item is
   new
Implicit_Indefinite_Unsigned_Data_Item with null record;

This type implement explicitly encoded indefinite INTEGER. 

Direct encoding. The following procedures are used for direct decoding and encoding:

procedure Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : out Stream_Element_Array
          );

This procedure takes an encoded representation of INTEGER from Data starting at the position specified by Pointer and stores it into Value (Value'First..Last). The representation is implicit, the ASN.1 type and length are not used. The length of encoding is determined by the parameter Value length. After successful completion Pointer is advanced to the position following the input and Last is the last stored element.

Exceptions
End_Error Not enough data. The sequence in Data is incomplete
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

procedure Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Stream_Element_Array
          );

This procedure puts an encoded representation of INTEGER into Data starting at the position specified by Pointer. The representation is implicit, the ASN.1 type and length are not used. After successful completion Pointer is advanced to the position following the output.

Exceptions
End_Error No room for output
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

17.18.8. Length

The package GNAT.Sockets.Connection_State_Machine.ASN1.Lengths provides an implementation of ASN.1 encoded length:

type Length_Data_Item is new Data_Item with record
   Value : Stream_Element_Count;
end record;

This type represents the ASN.1 encoded length. It is not derived from ASN1_Data_Item because it is a partial object.

procedure Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : out Stream_Element_Count
          );

This procedure takes an encoded representation of length from Data starting at the position specified by Pointer. Pointer is advanced to the position following the input. The result is placed into Value.

Exceptions
Constraint_Error The length is too large
Data_Error Invalid ASN.1 length
End_Error Not enough data. The sequence in Data is incomplete
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

procedure Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Stream_Element_Count
          );

This procedure puts an encoded representation of length into Data starting at the position specified by Pointer. Pointer is advanced to the position following the output.

Exceptions
End_Error No room for output
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

Feeding length. The ASN.1 length can be input in an implementation of Feed using the following subprograms:

procedure Embedded_Feed
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             State   : in out Stream_Element_Offset
          );

The embedded feed utilizes negative values of State for input ASN.1 length. The length is input as follows. From custom Feed:

State := Start_Length;
while not Is_Length_Ready (State) ... loop
   Embedded_Feed (..., State);
end loop;
Length := Get_Length (State);

All positive and zero values of State remain free for other uses.

function Is_Indefinite
         (  State : Stream_Element_Offset
         )  return Boolean;

The result is always false if State is positive or zero. Otherwise, it is true when the length is indefinite. Encodings having indefinite length end with two zero octets. Definite length encodings have the specified length.

function Is_Length_Ready
         (  State : Stream_Element_Offset
         )  return Boolean;

The result is true when the length is ready.

function Get_Length
         (  State : Stream_Element_Offset
         )  return Stream_Element_Count;

When the length is ready the result of this function is decoded length.

function Start_Length return Stream_Element_Offset;

This function returns the initial state of the length input.

17.18.9. Null

The package GNAT.Sockets.Connection_State_Machine.ASN1.Nulls provides an implementation of ASN.1 NULL:

type Implicit_Null_Data_Item is new ASN1_Data_Item with null record;
type Null_Data_Item is new Implicit_Null_Data_Item with null record;

These types implement implicitly and explicitly encoded NULL.

Direct encoding. The implicit encoding of ASN.1 NULL is empty.

17.18.10. Object identifier

The package GNAT.Sockets.Connection_State_Machine.ASN1.Object_Identifiers provides an implementation of ASN.1 OBJECT IDENTIFIER and RELATIVE-OID:

Absolute object identifier objects

type Implicit_OID_Data_Item (Size : Positive) is
   new
ASN1_Data_Item with
record

   Length : Natural := 0;
   Value  : Object_Identifier (1..Size);
end record;

This type implements implicitly encoded OBJECT IDENTIFIER.

function Get_Value
         (  Item : Implicit_OID_Data_Item
         )  return Object_Identifier;

This is a convenience function to get the actual value.

procedure Set_Value
          (  Item  : in out Implicit_OID_Data_Item;
             Value : Object_Identifier
          );

This is a convenience function to set the actual value. Constraint_Error is propagated when Value is too large.

type OID_Data_Item is new Implicit_OID_Data_Item with null record;

This type implements explicitly encoded OBJECT IDENTIFIER.

Relative object identifier objects

type Implicit_Relative_OID_Data_Item is
   new
Implicit_OID_Data_Item with null record;
type Relative_OID_Data_Item is
   new Implicit_Relative_OID_Data_Item with null record;

These types implement implicitly and explicitly encoded RELATIVE-OID.

External absolute object identifier objects

type Subindentifier_Ptr is access all Subindentifier_Type;
type
Implicit_External_OID_Data_Item is
   new ASN1_Data_Item with
record
   Buffer : External_String_Buffer_Ptr;
   Length : Natural;
   Value  : Subindentifier_Ptr;
end record;

This type implements implicit ASN.1 OBJECT IDENTIFIER types which keep the identifier in an external string buffer.

function Get_Buffer
         (  Item : Implicit_External_OID_Data_Item
         )  return External_String_Buffer_Ptr;

These functions return the external buffer used.

function Get_Length
         (  Item : Implicit_External_OID_Data_Item
         )  return Natural;

These functions return the actual value length.

function Get_Value
         (  Item : Implicit_External_OID_Data_Item
         )  return Object_Identifier;

These functions return the actual value.

procedure Set_Value
          (  Item  : in out Implicit_External_OID_Data_Item;
             Value : Object_Identifier
          );

These procedures set the value.

Exceptions
Storage_Error No room to store the value
Use_Error Item was not initialized yet

type External_OID_Data_Item is
   new Implicit_External_OID_Data_Item with null record;

This type implements explicit ASN.1 OBJECT IDENTIFIER types which keep the identifier in an external string buffer.

External relative object identifier objects

type Implicit_External_Relative_OID_Data_Item is
  new Implicit_External_OID_Data_Item with null record;

These types implement implicit and explicit ASN.1 RELATIVE-OID types which keep the identifier in an external string buffer.

function Get_Buffer
         (  Item : Implicit_External_Relative_OID_Data_Item
         )  return External_String_Buffer_Ptr;

These functions return the external buffer used.

function Get_Length
         (  Item : Implicit_External_Relative_OID_Data_Item
         )  return Natural;

These functions return the actual value length.

function Get_Value
         (  Item : Implicit_External_Relative_OID_Data_Item
         )  return Object_Identifier;

These functions return the actual value.

procedure Set_Value
          (  Item  : in out Implicit_External_Relative_OID_Data_Item;
             Value : Object_Identifier
          );

These procedures set the value.

Exceptions
Storage_Error No room to store the value
Use_Error Item was not initialized yet

type External_Relative_OID_Data_Item is
   new Implicit_External_Relative_OID_Data_Item with null record;

This type implements explicit ASN.1 RELATIVE-OID types which keep the identifier in an external string buffer.

Direct encoding. The following procedures are used for direct decoding and encoding:

procedure Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Length  : Stream_Element_Offset;
             Value   : out Object_Identifier;
             Last    : out Integer
          );

This procedure takes an encoded representation of UTF-8 or octet string from Data starting at the position specified by Pointer. The representation is implicit, the ASN.1 type and length are not used. The parameter Length specifies the encoding length. After successful completion Pointer is advanced to the position following the input. The result is placed into Value. Last is set to the last character overwritten.

Exceptions
Constraint_Error No room in Value to store
End_Error Not enough data. The sequence in Data is incomplete
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

function Get
         (  Data    : Stream_Element_Array;
            Pointer : access Stream_Element_Offset;
            Length  : Stream_Element_Offset
         )  return Object_Identifier;

This variant returns the string as a result.

Exceptions
End_Error Not enough data. The sequence in Data is incomplete
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

procedure Get_Relative
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Length  : Stream_Element_Offset;
             Value   : out Object_Identifier;
             Last    : out Integer
          );

This procedure takes an encoded representation of UTF-8 or octet string from Data starting at the position specified by Pointer. The representation is implicit, the ASN.1 type and length are not used. The parameter Length specifies the encoding length. After successful completion Pointer is advanced to the position following the input. The result is placed into Value. Last is set to the last character overwritten.

Exceptions
Constraint_Error No room in Value to store
End_Error Not enough data. The sequence in Data is incomplete
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

function Get_Relative
         (  Data    : Stream_Element_Array;
            Pointer : access Stream_Element_Offset;
            Length  : Stream_Element_Offset
         )  return Object_Identifier;

This variant returns the string as a result.

Exceptions
End_Error Not enough data. The sequence in Data is incomplete
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

procedure Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Object_Identifier
          );

This procedure puts an encoded representation of OBJECT IDENTIFIER into Data starting at the position specified by Pointer. The representation is implicit, the ASN.1 type and length are not used. After successful completion Pointer is advanced to the position following the output.

Exceptions
End_Error No room for output
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

procedure Put_Relative
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Object_Identifier
          );

This procedure puts an encoded representation of RELATIVE-OID into Data starting at the position specified by Pointer. The representation is implicit. After successful completion Pointer is advanced to the position following the output.

Exceptions
End_Error No room for output
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

17.18.11. Real

Several packages implement ASN.1 REAL:

The package GNAT.Sockets.Connection_State_Machine.ASN1.Generic_Real is a generic package instantiated with a floating-point type:

generic
   type
Number is digits <>;
   with package
Edit is new Strings_Edit.Float_Edit (Number);
package GNAT.Sockets.Connection_State_Machine.ASN1.Generic_Real is ...

The package declares the types:

type Implicit_Real_Data_Item is new ASN1_Data_Item with record
   Value : Number;
end record;
type Real_Data_Item is new Implicit_Real_Data_Item with null record;

These types implement implicitly and explicitly encoded REAL.

function Get_Value
         (  Item : Implicit_Real_Data_Item
         )  return Number;

This is a convenience function to get the actual value.

procedure Set_Value
          (  Item  : in out Implicit_Real_Data_Item;
             Value : Number
          );

This is a convenience function to set the actual value.

Direct encoding. The following procedures are used for direct decoding and encoding:

procedure Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Length  : Stream_Element_Offset;
             Value   : out Number
          );

This procedure takes an encoded representation of REAL from Data starting at the position specified by Pointer. The representation is implicit, the ASN.1 type and length are not used. Length is the encoding length. After successful completion Pointer is advanced to the position following the input. The result is placed into Value.

Exceptions
Constraint_Error The value is too large or value is not a number
Data_Error Encoding error
End_Error Not enough data. The sequence in Data is incomplete
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

procedure Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : Number
          );
procedure
Put
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : String
          );

This procedure puts an encoded representation of REAL into Data starting at the position specified by Pointer. The representation is implicit, the ASN.1 type and length are not used. After successful completion Pointer is advanced to the position following the output. When Value is numeric the machine radix is used in the encoding. When Value is string it must be a decimal number representation. It use one of textual encodings depending on if decimal point or exponent is present in Value.

Exceptions
End_Error No room for output
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

17.18.12. Sequence

The package GNAT.Sockets.Connection_State_Machine.ASN1.Sequences is the root package of the implementations of ASN.1 SEQUENCE and SEQUENCE OF.

Untagged sequence objects. A sequence contains any number of other ASN.1 objects input in the order they appear in the sequence. The data type implements an empty sequence. A sequence contains any number of other ASN.1 objects input in the order they appear in the sequence. The data type implements an empty sequence. A non-empty sequence is declared by deriving a new type from it and placing items derived from Abstract_ASN1_Data_Item into it:

type Name_And_Check is new Sequence_Data_Item with record
   Name  : String_Data_Item (200);
   Check : Boolean_Data_Item;
end record;

This is equivalent to ASN.1

SEQUENCE
{  Name  OCTET STRING,
   Check BOOLEAN
}

Note that all items in the sequence are non-tagged. See tagged sequences for having tags and optional elements in the sequence.

type Implicit_Sequence_Data_Item is new ASN1_List_Data_Item with private;

This type is declared in the child package Implicit than implements implicitly encoded SEQUENCE.

function Get_Children
         (  Item : Implicit_Sequence_Data_Item
         )  return Data_Item_Ptr_Array;

This function is an overriding of the primitive operation of Data_Item that returns the elements of the sequence. Use_Error is propagated when Item was not initialized yet.

procedure Initialized
          (  Item : in out Implicit_Sequence_Data_Item
          );

This procedure is called when all components of the object have been enumerated, so that some additional initialization could be finished with all components known. The default implementation does nothing.

type Sequence_Data_Item is new Implicit_Sequence_Data_Item with null record;

This type is declared in the child package Explicit that implements explicitly encoded SEQUENCE.

Tagged sequence objects. A tagged sequence contains any number of tagged ASN.1 objects input in the order they appear in the sequence. The objects can be optional which is recognized using the tags. The data types implement an empty sequence. A non-empty sequence is declared by deriving a new type from it and placing items derived from  Abstract_ASN1_Data_Item into it:

type Four_Integers is new Tagged_Sequence_Data_Item with record
   A : Integer_Data_Item;
   B : Implicit_Integer_Data_Item;
   C : Implicit_Integer_Data_Item;
   D : Implicit_Integer_Data_Item;
end record;

This is equivalent to ASN.1

SEQUENCE
{  A [0] INTEGER,
   B [1] IMPLICIT INTEGER,
   C [2] IMPLICIT INTEGER,
   D [3] IMPLICIT INTEGER
}

The tags by-default are set context-specific in the ascending order. The tags can be modified in order to have other classes, values or having elements optional. When a tagged element is marked optional, then it can be skipped if the tag does not match. This behaviour corresponds to ASN.1 sequences like:

SEQUENCE
{  A [0] INTEGER,
   B [1] IMPLICIT INTEGER OPTIONAL,
   C [2] IMPLICIT INTEGER,
   D [3] IMPLICIT INTEGER
}

Note that explicitly encoded object are equivalent to universally tagged implicitly encoded ones. Therefore an untagged sequence of explicitly encoded integers:

SEQUENCE
{  A INTEGER,
   B INTEGER,
   C INTEGER,
   D INTEGER
}

can be replaced by equivalent tagged sequence:

SEQUENCE
{  A [UNIVERSAL 2] IMPLICIT INTEGER,
   B [UNIVERSAL 2] IMPLICIT INTEGER,
   C [UNIVERSAL 2] IMPLICIT INTEGER,
   D [UNIVERSAL 2] IMPLICIT INTEGER
}

Here 2 is the ASN.1 type INTEGER. Universal tags are matched against the actual type of the element. This behavior can be relaxed by marking the element universal. Such elements are matched by any universal tag. This is used mostly in the cases when the actual type of an element is unspecified. An octet string can be then used to receive the content of any actual type. The elements can be also set untagged. Such elements in most cases must be encoded explicitly, because only few ASN.1 types have fixed-length encoding.

type Implicit_Tagged_Sequence_Data_Item is
   new
ASN1_Tagged_List_Data_Item with private;

This type is declared in the child package Implicit. It implements implicitly and explicitly encoded SEQUENCE with tagged elements

function Get_Children
         (  Item : Implicit_Tagged_Sequence_Data_Item
         )  return Data_Item_Ptr_Array;

These functions override of the primitive operation of Data_Item that returns the elements of the sequence. Use_Error is propagated when Item was not initialized yet.

procedure Initialized (Item : in out Implicit_Tagged_Sequence_Data_Item);

These procedures are called when all components of the object have been enumerated, so that some additional initialization could be finished with all components known. A typical use is to set the tags of the sequence elements. The default implementation does nothing.

function Is_Universal
         (  Item  : Implicit_Tagged_Sequence_Data_Item;
            Index : Positive
         )  return Boolean;

These functions return the true if the sequence element matches any universal tag. The element is specified by its index in the range 1..Get_Length.

Exceptions
Constraint_Error The index is out of range 1..Get_Length
Use_Error The sequence was not initialized yet

procedure Reset
          (  Item  : in out Implicit_Tagged_Sequence_Data_Item;
             Index : Positive;
             Unset : Boolean
          );

These procedures mark the element set or unset according to the parameter Unset. The element is specified by its index in the range 1..Get_Length.

Exceptions
Constraint_Error The index is out of range 1..Get_Length
Use_Error The sequence was not initialized yet

procedure Set_Optional
          (  Item     : in out Implicit_Tagged_Sequence_Data_Item;
             Index    : Positive;
             Optional : Boolean
          );

These procedures change the element's tag to make element optional or mandatory according to the parameter Optional. The element is then marked unset or set correspondingly. The element is specified by its index in the range 1..Get_Length.

Exceptions
Constraint_Error The index is out of range 1..Get_Length
Status_Error The element is untagged
Use_Error The sequence was not initialized yet

procedure Set_Tag
          (  Item      : in out Implicit_Tagged_Sequence_Data_Item;
             Index     : Positive;
             Tag       : Tag_Type;
             Unset     : Boolean := False;
             Universal : Boolean := False
          );

These procedures change the element's tag. By default the tags are assigned context-specific in ascending order starting from 0. The parameter Unset marks the element unset when true. Unset elements are skipped by Encode. Upon input Feed marks absent optional elements unset. When Tag is universal and has the value 0 the type of the corresponding element is used instead. The element is specified by its index in the range 1..Get_Length. When the parameter Universal is true, then the actual universal tag is ignored. Normally the element must be an octet string which is capable to receive the content of any other type.

Exceptions
Constraint_Error The index is out of range 1..Get_Length
Use_Error The sequence was not initialized yet

procedure Set_Untagged
          (  Item  : in out Implicit_Tagged_Sequence_Data_Item;
             Index : Positive
          );

These procedures set the element untagged. By default the tags are assigned context-specific in ascending order starting from 0. Untagged elements cannot be optional. The element is specified by its index in the range 1..Get_Length.

Exceptions
Constraint_Error The index is out of range 1..Get_Length
Use_Error The sequence was not initialized yet

type Tagged_Sequence_Data_Item is
   new
Implicit_Tagged_Sequence_Data_Item with null record;

This type is declared in the child package Explicit and implements explicitly encoded SEQUENCE with tagged elements

17.18.13. Sequence of

The package GNAT.Sockets.Connection_State_Machine.ASN1.Sequences also provides implementations of ASN.1 SEQUENCE OF. The sequence has all elements of same ASN.1 type. A sequence should contain an array of ASN.1 objects. The sequence inputs objects an fills the array. The number of objects is returned by the function Get_Length. For example:

type Integer_Array is
   array
(Positive range <>) of Integer_Data_Item;
type Array_Of_Integers (Size : Positive) is
   new
Sequence_Of_Data_Item with
record

   Values : Integer_Array (1..Size);
end record;

This is equivalent to ASN.1

SEQUENCE OF INTEGER

The sequence has no tags. If elements of the sequence are implicit there is no way to determine their lengths except for few cases. Note also that Integer_Array in the example does not have Write stream attribute generated. This must be done explicitly, e.g.

procedure Enumerate
          (  Stream : access Root_Stream_Type'Class;
             Item   : Integer_Data_Array
          )  is null;
for
Integer_Data_Array'Write use Enumerate;

type Public_Sequence_Of_Data_Item is
   abstract new
ASN1_List_Data_Item
record
   Length : Natural := 0;
end record
;

This is the public base type of the sequence types

procedure Initialized
          (  Item : in out Public_Sequence_Of_Data_Item
          );

This procedure is called when all components of the object have been enumerated, so that some additional initialization could be finished with all components known. A typical use is to set the tags of the sequence elements. The default implementation does nothing.

type Implicit_Sequence_Of_Data_Item is
   new
Public_Sequence_Of_Data_Item with private;

This type from the child package Implicit implements implicitly encoded ASN.1 SEQUENCE OF.

type Sequence_Of_Data_Item is
   new
Implicit_Sequence_Of_Data_Item with null record;

This type is declared in the child package Explicit. It implements explicitly typed ASN.1 SEQUENCE OF.

Dynamic sequence objects. These sequences have elements allocated externally in a string buffer. The object itself must contain no items. As a matter of fact, there is no other difference between set and sequence except for the type. See for the base type Implicit_External_Set_Of_Data_Item for more details.

type Implicit_External_Sequence_Of_Data_Item is
   abstract new
Implicit_External_Set_Of_Data_Item with null record;

This type from the child package Implicit implements implicitly encoded sequences with elements allocated externally in a string buffer.

type External_Sequence_Of_Data_Item is
   abstract new External_Set_Of_Data_Item
with null record;

This type from the child package Explicit implements explicitly encoded sequences with elements allocated externally in a string buffer.

Generic dynamic sequence objects. The generic package GNAT.Sockets.Connection_State_Machine.ASN1.Sequences.Generic_Sequence_Of provides a simplified method to create a dynamic SEQUENCE OF for a specific type:

generic
   type
Value_Type (<>) is private;
   type Element_Type is new Abstract_ASN1_Data_Item with private;
   with function Get (Element : Element_Type) return Value_Type is <>;
   with procedure Set
                  (  Element : in out Element_Type;
                     Value   : Value_Type
                  )  is <>;
package GNAT.Sockets.Connection_State_Machine.ASN1.Sequences.
        Generic_Sequence_Of is ...

The formal parameters of the package are:

The package declares types to implement implicitly and explicitly encoded SET OF with elements of Element_Type allocated dynamically in an external string buffer:

type Implicit_Sequence_Of is
   new
Implicit_External_Set_Of_Data_Item with null record;
type
Sequence_Of is
   new
External_Set_Of_Data_Item with null record;
type Element_Type_Ptr is access all Element_Type;

These types implement implicitly and explicitly encoded SEQUENCE OF with elements allocated dynamically in an external string buffer.

procedure Append
          (  Item  : in out Implicit_Sequence_Of;
             Value : Value_Type
          );
procedure Append
          (  Item  : in out Sequence_Of;
             Value : Value_Type
          );

These procedures are used to add a new element to the sequence.

Exceptions
Storage_Error No room in the external buffer
Use_Error The set was not initialized yet

function Get
         (  Item  : Implicit_Sequence_Of;
            Index : Positive
         )  return Value_Type;
function Get
         (  Item  : Sequence_Of;
            Index : Positive
         )  return Value_Type;

These functions return the actual value of the set element specified by its index 1..Get_Length.

Exceptions
Constraint_Error The index is out of range 1..Get_Length
Use_Error The set was not initialized yet

function Get
         (  Item  : Implicit_Sequence_Of;
            Index : Positive
         )  return Element_Type_Ptr;
function Get
         (  Item  : Sequence_Of;
            Index : Positive
         )  return Element_Type_Ptr;

These functions return the ASN.1 data item of the set element specified by its index 1..Get_Length.

Exceptions
Constraint_Error The index is out of range 1..Get_Length
Use_Error The set was not initialized yet

procedure Set_Value
          (  Item  : in out Implicit_Sequence_Of;
             Index : Positive;
             Value : Value_Type
          );
procedure Set_Value
          (  Item  : in out Sequence_Of;
             Index : Positive;
             Value : Value_Type
          );

These procedures set the value of the set element specified by its index 1..Get_Length.

Exceptions
Constraint_Error The index is out of range 1..Get_Length
Storage_Error No room in the external buffer
Use_Error The set was not initialized yet

17.18.14. Set

The package GNAT.Sockets.Connection_State_Machine.ASN1.Sets is the root package of the implementations of ASN.1 SET.

Set objects. A set contains any number of other ASN.1 objects input in any order. The objects must be tagged to determine the order. The data types implement an empty set. A non-empty set is declared by deriving a new type from it and placing items derived from ASN1_Data_Item into it:

type Client_Record is new Set_Data_Item with record
   Name      : String_Data_Item (20);
   Street    : String_Data_Item (80);
   Post_Code : String_Data_Item (Numeric_String_Tag, 80);
end record;

This is equivalent to ASN.1

SET
{  Name      [0] OCTET STRING,
   Street    [1] OCTET STRING,
   Post_Code [2] NUMERIC STRING
}

The elements can be marked optional in which case they are ignored when missing in the input and are not output by Encode. The same type implementation is used for both ASN.1 SET and SET OF. When the set contains elements distinguished by types like:

SET
{  Name      OCTET STRING,
   Post_Code NUMERIC STRING
}

that is equivalent to

SET
{  Name      [UNIVERSAL  4] IMPLICIT OCTET STRING,
   Post_Code [UNIVERSAL 18] IMPLICIT NUMERIC STRING
}

which is then declared as follows:

type Client_Record is new Set_Data_Item with record
   Name      : Implicit_Constrained_String_Data_Item (Octet_String_Tag,   20);
   Post_Code : Implicit_Constrained_String_Data_Item (Numeric_String_Tag, 80);
end record;

with the tags set accordingly to the universal tags of the corresponding types (see Set_Tag).

type Implicit_Set_Data_Item is new ASN1_Tagged_List_Data_Item with private;

This type is declared in the child package Implicit to implement implicitly encoded SET.

function Get_Children
         (  Item : Implicit_Set_Data_Item
         )  return Data_Item_Ptr_Array;

These functions override the primitive operation of Data_Item that returns the set elements. Use_Error is propagated when Item was not initialized yet.

procedure Initialized (Item : in out Implicit_Set_Data_Item);

These procedures are called when all components of the object have been enumerated, so that some additional initialization could be finished with all components known. The default implementation does nothing.

procedure Reset
          (  Item  : in out Implicit_Set_Data_Item;
             Index : Positive;
             Unset : Boolean
          );

These procedures mark the element set or unset according to the parameter Unset. The element is specified by its index in the range 1..Get_Length.

Exceptions
Constraint_Error The index is out of range 1..Get_Length
Use_Error The set was not initialized yet

procedure Set_Optional
          (  Item     : in out Implicit_Set_Data_Item;
             Index    : Positive;
             Optional : Boolean
          );

These procedures change the element's tag to make element optional or mandatory according to the parameter Optional. The element is then marked unset or set correspondingly. The element is specified by its index in the range 1..Get_Length.

Exceptions
Constraint_Error The index is out of range 1..Get_Length
Use_Error The sequence was not initialized yet

procedure Set_Tag
          (  Item  : in out Implicit_Set_Data_Item;
             Index : Positive;
             Tag   : Tag_Type;
             Unset : Boolean := False
          );

These procedures change the element's tag. By default the tags are assigned context-specific in ascending order starting from 0. The parameter Unset marks the element unset when true. Unset elements are skipped by Encode. Upon input Feed marks absent optional elements unset. When the tag is universal the corresponding object must be implicit otherwise Mode_Error is propagated. It is also propagated when the tag value of universal tag differs from the object's ASN.1 type or when the tag does not indicate optional choice (all choice alternatives must be optional). The element is specified by its index in the range 1..Get_Length. All tags must be unique for the set to be able to select elements by the tag. When there is already an element tagged by the same tag Constraint_Error is propagated.

Exceptions
Constraint_Error The index is out of range 1..Get_Length or the tag is in use
Mode_Error Wrongly tagged object
Use_Error The set was not initialized yet

type Set_Data_Item is new Implicit_Set_Data_Item with null record;

This type is declared in the child package Explicit to implement explicitly encoded SET.

Dynamic object

type Reference_Data_Item is
   abstract new
ASN1_Data_Item with private;

This type declared in GNAT.Sockets.Connection_State_Machine.ASN1.Sets implements a dynamically created object in an external string buffer. It acts a singleton set. The type is abstract, Create must be implemented.

function Create
         (  Item : access Reference_Data_Item
         )  return Abstract_ASN1_Data_Item_Ptr is abstract;

The derived type must implement this function in order to have a specific data type to allocate. The element must be allocated in the pool obtained by Get_Container. Storage_Error is propagated when there is no room to allocate the new item.

function Get_Container
         (  Item : Reference_Data_Item
         )  return External_String_Buffer_Ptr;

These functions return the container used to store set elements. The result is null if the set is not initialized and the container is not set.

function Get
         (  Item     : Reference_Data_Item;
            Allocate
: Boolean := False
         )  return Abstract_ASN1_Data_Item_Ptr;

This function returns the actual target. If Allocate is true, the element is created if does not exist.

Exceptions
Data_Error The target does not exist and Allocate is false
Storage_Error No room in the external buffer
Use_Error Item was not initialized yet

Generic dynamic object. The generic package GNAT.Sockets.Connection_State_Machine.ASN1.Sets.Generic_Reference provides a simplified method to create a dynamic SET OF a specific type:

generic
   type
Value_Type (<>) is private;
   type Element_Type is new Abstract_ASN1_Data_Item with private;
   with function Get (Element : Element_Type) return Value_Type is <>;
   with procedure Set
                  (  Element : in out Element_Type;
                     Value   : Value_Type
                  )  is <>;
package GNAT.Sockets.Connection_State_Machine.ASN1.Sets.
        Generic_Reference is ...

The formal parameters of the package are:

The package declares types to implement Element_Type allocated dynamically in an external string buffer:

type Reference_To is new Reference_Item with null record;
type
Element_Type_Ptr is access all Element_Type;

The following operations are defined:

function Get
         (  Item     : Reference_To;
            Allocate : Boolean := False
         )  return Value_Type;

This function return the actual value of the target.

Exceptions
Data_Error The target does not exist and Allocate is false
Storage_Error No room in the external buffer if it does not exist
Use_Error The reference was not initialized yet

function Get
         (  Item     : Reference_To;
            Allocate : Boolean := False
         )  return Element_Type_Ptr;

These functions return the ASN.1 data item or null if it does not exist and Allocate is false.

Exceptions
Storage_Error No room in the external buffer if it does not exist
Use_Error The reference was not initialized yet

procedure Set_Value
          (  Item     : in out Reference_To;
             Value    : Value_Type;
             Allocate : Boolean := False
          );

These procedures set the value into the target.

Exceptions
Data_Error The target does not exist and Allocate is false
Storage_Error No room in the external buffer if it does not exist
Use_Error The reference was not initialized yet

17.18.15. Set of

The child packages of GNAT.Sockets.Connection_State_Machine.ASN1.Sets also provide implementation of ASN.1 SET OF.

Dynamic set objects

type Implicit_External_Set_Of_Data_Item is
   abstract new
ASN1_List_Data_Item with private;

This type declared in the child package Implicit implements implicitly encoded SET OF with elements allocated dynamically in an external string buffer. The object itself must contain no items. The type is abstract, Create must be implemented to provide elements.

procedure Append
          (  Item : in out Implicit_External_Set_Of_Data_Item
          );

These procedures are used to add a new element to the set.

Exceptions
Storage_Error No room in the external buffer
Use_Error The set was not initialized yet

function Create
         (  Item : access Implicit_External_Set_Of_Data_Item
         )  return Abstract_ASN1_Data_Item_Ptr is abstract;

The derived type must implement this function in order to have a specific data type to allocate. The element must be allocated in the pool obtained by Get_Container. Storage_Error is propagated when there is no room to allocate the new item. The set elements are not tagged. Therefore Create should return definite element. For example, if definite integer is returned the result would be:

SET OF INTEGER

function Get_Container
         (  Item : Implicit_External_Set_Of_Data_Item
         )  return External_String_Buffer_Ptr;

These functions return the container used to store set elements. The result is null if the set is not initialized and the container is not set.

function Get_Children
         (  Item : Implicit_External_Set_Of_Data_Item
         )  return Data_Item_Ptr_Array;

These functions override the primitive operation of Data_Item that returns the set elements. Use_Error is propagated when set is not initialized.

type External_Set_Of_Data_Item is
   abstract new
Implicit_External_Set_Of_Data_Item with null record;

This type declared in the child package Explicit implements explicitly encoded SET OF with elements allocated dynamically in an external string buffer. The object itself must contain no items. The type is abstract, Create must be implemented to provide elements.

Generic dynamic set objects. The generic package GNAT.Sockets.Connection_State_Machine.ASN1.Sets.Generic_Set_Of provides a simplified method to create a dynamic SET OF for a specific type:

generic
   type
Value_Type (<>) is private;
   type Element_Type is new Abstract_ASN1_Data_Item with private;
   with function Get (Element : Element_Type) return Value_Type is <>;
   with procedure Set
                  (  Element : in out Element_Type;
                     Value   : Value_Type
                  )  is <>;
package GNAT.Sockets.Connection_State_Machine.ASN1.Sets.
        Generic_Set_Of is ...

The formal parameters of the package are:

The package declares types to implement implicitly and explicitly encoded SET OF with elements of Element_Type allocated dynamically in an external string buffer:

type Implicit_Set_Of is
   new
Implicit_External_Set_Of_Data_Item with null record;
type
Set_Of is
   new
External_Set_Of_Data_Item with null record;
type Element_Type_Ptr is access all Element_Type;

These types implement implicitly and explicitly encoded SET OF with elements allocated dynamically in an external string buffer.

function Get
         (  Item  : Implicit_Set_Of;
            Index : Positive
         )  return Value_Type;
function Get
         (  Item  : Set_Of;
            Index : Positive
         )  return Value_Type;

These functions return the actual value of the set element specified by its index 1..Get_Length.

Exceptions
Constraint_Error The index is out of range 1..Get_Length
Use_Error The set was not initialized yet

function Get
         (  Item  : Implicit_Set_Of;
            Index : Positive
         )  return Element_Type_Ptr;
function Get
         (  Item  : Set_Of;
            Index : Positive
         )  return Element_Type_Ptr;

These functions return the ASN.1 data item of the set element specified by its index 1..Get_Length.

Exceptions
Constraint_Error The index is out of range 1..Get_Length
Use_Error The set was not initialized yet

procedure Set_Value
          (  Item  : in out Implicit_Set_Of;
             Index : Positive;
             Value : Value_Type
          );
procedure Set_Value
          (  Item  : in out Set_Of;
             Index : Positive;
             Value : Value_Type
          );

These procedures set the value of the set element specified by its index 1..Get_Length.

Exceptions
Constraint_Error The index is out of range 1..Get_Length
Storage_Error No room in the external buffer
Use_Error The set was not initialized yet

17.18.16. String

The package GNAT.Sockets.Connection_State_Machine.ASN1.Strings is the root package of various ASN.1 string implementations. The implementation supports constructed strings. The ASN.1 strings tags are processed as following:

Tag Actions
BMP_String_Tag Big-endian encoded UCS-2 elements are converted to UTF-8
Character_String_Tag Latin-1 encoded elements are converted to UTF-8
Graphic_String_Tag Passed as-is
General_String_Tag Passed as-is
IA5_String_Tag Checked to be 7-bit ASCII
ISO646_String_Tag Checked to contain code points from space (' ') to '~': 32..126
Numeric_String_Tag Checked to contain '0'..'9' or space (' ')
Octet_String_Tag Passed as-is
Printable_String_Tag Checked to contain 'A'..'Z', 'a'..'z', '0'..'9', space (' '), ''', '(', ')', '+', '-', ',', '.', '/', ';', '=', '?': 32, 39..41..57, 59, 61, 63, 65..132, 97..122
Teletext_String_Tag Checked and converted from ITU T.61 to UTF-8
Universal_String_Tag Big-endian encoded UCS-4 elements are converted to UTF-8
Videotext_String_Tag Passed as-is

The value stored in the object is always UTF-8 encoded. When the input and output they are consistently recoded into and from UTF-8.

Base string object type

type Public_String_Data_Item
     (  Size : Natural
     )  is abstract new ASN1_Data_Item with
record

   Length : Natural := 0; -- The actual length of the value
   Value  : String (1..Size);
end record;

This is the public view of all ASN.1 compound string objects.

function Get_Length
         (  Item : Public_String_Data_Item
         )  return String;

This is a convenience function to get the length of the actual value.

function Get_Value
         (  Item : Public_String_Data_Item
         )  return String;

This is a convenience function to get the actual value.

procedure Set_Value
          (  Item  : in out Public_String_Data_Item;
             Value : String
          );

This is a convenience function to set the actual value.

Direct encoding. The following procedures are used for direct decoding and encoding date and time:

procedure Get
          (  Data    : Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : out String
          );

This procedure takes an encoded representation of UTF-8 or octet string from Data starting at the position specified by Pointer. The representation is implicit, the ASN.1 type and length are not used. After successful completion Pointer is advanced to the position following the input. The result is placed into Value.

Exceptions
Constraint_Error No room in Value to store
End_Error Not enough data. The sequence in Data is incomplete
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

procedure Put[_BMP|_ITU_T61|_Latin1_|_Universal]
          (  Data    : in out Stream_Element_Array;
             Pointer : in out Stream_Element_Offset;
             Value   : String
          );

This procedure puts an encoded UTF-8 or octet string into Data starting at the position specified by Pointer. The representation is implicit, the ASN.1 type and length not used. After successful completion Pointer is advanced to the position following the output. Other variants use big-endian UCS-2 (Put_BMP), ITU T.61 (Put_ITU_T61), Latin-1 (Put_Latin1), UCS-4 (Put_Universal).

Exceptions
Constraint_Error Invalid UTF-8 encoding or else code point unsupported  by the output encoding
End_Error No room for output
Layout_Error Pointer is out of bounds Data'First..Data'Last + 1

String objects. The child package Implicit provides implementation of implicitly encoded string:

type Implicit_String_Data_Item is
   new Public_String_Data_Item with private;

The child package Explicit provides implementation of explicitly encoded representation:

type String_Data_Item is
  new Implicit_String_Data_Item with null record;

Constrained string objects. The child package Implicit.Constrained provides implementation of implicitly encoded string restricted to the type specified by the type's discriminant String_Type. The input must match the constraint specified by String_Type. The output must match the constraint and be compatible with UTF-8 encoding.

type Implicit_Constrained_String_Data_Item is
     (  String_Type : ASN1_Type;
        Size        : Natural
     )  is new Implicit_String_Data_Item (Size) with private;

The child package Explicit.Constrained provides implementation of explicitly encoded representation restricted by the discriminant String_Type::

type Constrained_String_Data_Item is
     (  String_Type : ASN1_Type;
        Size        : Natural
     )  is new String_Data_Item (Size) with private;

External string objects. The child package Implicit provides implicitly encoded ASN.1 string type which keeps the string values in an external string buffer.

type Implicit_External_String_Data_Item is
  new ASN1_Data_Item with private;

The objects of this type can share the same buffer to store the string contents. E.g. if an ASN.1 choice consists of many string alternatives it might be reasonable to use single buffer for them all since only one alternative is realized. Other cases is to specify the upper memory limit for all strings in a packet. The input may have any ASN.1 type which is converted to UTF-8. The output is ASN.1 UTF-8 string. The following additional operations are defined:

function Get_Buffer
         (  Item : Implicit_External_String_Data_Item
         )  return External_String_Buffer_Ptr;

These functions return the external buffer used. 

function Get_Length
         (  Item : Implicit_External_String_Data_Item
         )  return Natural;

These functions return the actual value length.

function Get_Value
         (  Item : Implicit_External_String_Data_Item
         )  return String;

These functions return the actual value.

procedure Set_Value
          (  Item  : in out Implicit_External_String_Data_Item;
             Value : String
          );

These procedures set the value.

Exceptions
Storage_Error No room to store the value
Use_Error Item was not initialized yet

The child package Explicit provides implementation of explicitly encoded representation:

type External_String_Data_Item is
   new Implicit_External_String_Data_Item with null record;

Constrained external string objects. The child package Implicit.Constrained provides implementation of implicitly encoded representation restricted to a single string type:

type Implicit_Constrained_External_String_Data_Item
     (  String_Type : ASN1_Type
     )  is new Implicit_External_String_Data_Item with null record;

The input must match the constraint specified by String_Type. The output must match the constraint and be compatible with UTF-8 encoding. The string values are kept in an external string buffer.

type Constrained_External_String_Data_Item
     (  String_Type : ASN1_Type
     )  is new ASN1_Data_Item with null record;

This type is declared in the child package Explicit.Constrained and provides implementation of explicitly encoded representation restricted to a single string type.

17.18.17. Tagged value

The package GNAT.Sockets.Connection_State_Machine.ASN1.Tagged_Values provides an implementation of ASN.1 tagged objects.

type Public_Tagged_Data_Item is
   abstract new
ASN1_Data_Item with
record

   Tag : Tag_Type;
end record;
type Tagged_Data_Item is new Public_Tagged_Data_Item with private;

This type represents a tagged object that contains another object for which it provides the tag. For example:

type Tagged_Name is new Tagged_Data_Item with record
   Value : Implicit_String_Data_Item (100);
end record;

After input, the component Tag contains the actual value of the tag and Value does the input string. In ASN.1 notation it could be put as:

[x] IMPLICIT OCTET STRING

procedure Initialized (Item : in out Tagged_Data_Item);

This procedure is called when all components of the object have been enumerated, so that some additional initialization could be finished with all components known. The default implementation does nothing.

17.18.18. Any object (parser)

The package GNAT.Sockets.Connection_State_Machine.ASN1.Objects provides means to input any ASN.1 object without knowing its structure.

type Any_Data_Item is new ASN1_Data_Item with private;

This type represents any tagged object. Upon input Feed decodes the tags of incoming objects and creates corresponding Ada objects to accommodate their content. The objects are allocated in an external string buffer. The process is recursive. The result is a three of objects. Leaves are objects like INTEGER or OCTET STRING. Braches are SEQUENCE and SET. Note that is no possible to distinguish, e.g. SEQUENCE and SEQUENCE OF. When an object is tagged with a non-universal tag the three contains an Any_Data_Item node to carry the tag.

function Get
         (  Item : Any_Data_Item
         )  return Abstract_ASN1_Data_Item_Ptr;

This function returns the actual ASN.1 object. Any_Data_Item itself contains tag and the object returned by this function. Use_Error is propagated when the object is not initialized or yet input.

function Get_Container
         (  Item : Any_Data_Item
         )  return External_String_Buffer_Ptr;

This function returns the external string buffer used to allocate the objects.

function Get_Tag
         (  Item : Any_Data_Item
         )  return Tag_Type;

This function returns the tag contained by Any_Data_Item. When the tag is universal it is the tag of the contained object. Use_Error is propagated when the object is not initialized or yet input.

17.18.19. X.509 certificates

The package GNAT.Sockets.Connection_State_Machine.ASN1.X509_Certificates provides X.509 certificate definition.

type X509_Certificate is
   new
Tagged_Sequence_Data_Item with
record

   Certificate : TBS_Certificate;
   Algorithm   : Algorithm_Identifier;
   Value       : Implicit_External_Bit_String_Data_Item;
end record;

This type represents an X.509 certificate:

type TBS_Certificate is
   new
Implicit_Tagged_Sequence_Data_Item with
record

   Version           : ASN1.Unsigneds_8.Unsigned_Data_Item;
   Serial_Number     : Implicit_Indefinite_Unsigned_Data_Item;
   Signature         : Algorithm_Identifier;
   Issuer            : Name_Type;
   Validity          : Validity_Time;
   Subject           : Name_Type;
   Key_Info          : Subject_Public_Key_Info;
   Issuer_Unique_ID  : Unique_Identifier;
   Subject_Unique_ID : Unique_Identifier;
   Extensions        : Extension_Sequence;
end record;

The certificate contents are allocated in an external string buffer.

type Subject_Public_Key_Info is
   new Implicit_Tagged_Sequence_Data_Item with
record

   Algorithm  : Algorithm_Identifier;
   Public_Key : Implicit_External_Bit_String_Data_Item;
end record;

The public key structure is opaque sequence of bits. The contents depends on the concrete algorithm. Usually it is some encapsulated ASN.1 structure.

type Algorithm_Identifier is
   new
Implicit_Tagged_Sequence_Data_Item with
record

   Algorithm  : Implicit_External_OID_Data_Item;
   Parameters : Implicit_External_String_Data_Item;
end record;

The algorithm identifier contains its OID and opaque parameters.

Stream I/O. The object X509_Certificate can also be used for stream and file I/O. The package GNAT.Sockets.Connection_State_Machine.ASN1.X509_Certificates.Stream_IO provides an object to read from and write into stream.

type X509_Certificate_Data (Size : Positive) is
   new
State_Machine (1, 1) with
record

   Buffer      : External_String_Buffer (Size);
   Certificate : X509_Certificate;
   Completed   : Boolean := False;
end record;

The data type encapsulates the X.509 certificate ASN.1 representation object and the buffer that keeps the dynamic certificate data. Reserve space generously, certificates are large objects. 10_000 is a good starting point. The object can read from and written into stream Base64 encoded in the format customary for keeping certificates. The certificate contents are allocated in an external string buffer which size is determined by the discriminant.

procedure Read
          (  Stream      : in out Root_Stream_Type'Class;
             Certificate : in out X509_Certificate_Data
          );

This procedure reads stream until -----BEGIN CERTIFICATE----- appears. Then the certificate is input until -----END CERTIFICATE-----, which is also consumed. The certificate between these two lines is Base64 encoded. The formatting characters, space and tabs (code points 9..13, 32) are ignored.

Exceptions
Data_Error Errors in the certificate
End_Error Premature stream end before certificate found
Storage_Error The buffer is too small to hold the certificate
I/O exceptions I/O errors

procedure Write
          (  Stream      : in out Root_Stream_Type'Class;
             Certificate : X509_Certificate_Data
          );

This procedure writes -----BEGIN CERTIFICATE----- line, then Base64 encoded certificate and -----END CERTIFICATE----- line.

Exceptions
Data_Error Errors in the certificate
I/O exceptions I/O errors

17.18.20. Text output

The package GNAT.Sockets.Connection_State_Machine.ASN1.Text_IO provides text output of ASN.1 objects:

procedure Put
          ([ File   : File_Type; ]
             Item   : ASN1_Data_Item'Class;
             Prefix : String := "";
             Wrap   : Positive_Count := 72
          );

These procedures recursively dump the object Item into File or standard output. Prefix is the text that prefixes each object's component. Wrap is the file column to wrap output. It is ignored when nesting becomes too deep.

[Back][TOC][Next]

17.19. LDAP

Lightweight Directory Access Protocol (LDAP) is protocol to access a tree-like structure. The protocol is described using ASN.1.

17.19.1. LDAP peer

The package GNAT.Sockets.Connection_State_Machine.LDAP provides an implementation of a LDAP peer:

type LDAP_Peer
     (  Listener           : access Connections_Server'Class;
        Message_Length     : Buffer_Length;
        Incoming_Data_Size : Positive;
        Outgoing_Data_Size : Positive;
        Input_Size         : Buffer_Length;
        Output_Size        : Buffer_Length
     )  is new State_Machine
               (  Input_Size  => Input_Size,
                  Output_Size => Output_Size
               )  with
record

      -- Incoming message
   Buffer  : External_String_Buffer (Incoming_Data_Size);
   Message : LDAP_Message;
      -- Outgoing message
   Output  : LDAP_Output (Message_Length, Outgoing_Data_Size);
end record;

The objects of LDAP_Peer implement LDAP server and client connections. The discriminants are:

There are specialized child packages for servers (GNAT.Sockets.Connection_State_Machine.LDAP.Server) and clients (GNAT.Sockets.Connection_State_Machine.LDAP.Client). The package declares basic types:

type Result_Code is mod 2**8;
Success_Code                   : constant Result_Code := 0;
   ...
Compare_False_Code             : constant Result_Code := 5;
Compare_True_Code              : constant Result_Code := 6;
Auth_Method_Not_Supported_Code : constant Result_Code := 7;
   ...
Unwilling_To_Perform_Code      : constant Result_Code := 53;
   ...

This type defines the LDAP result code.

function Image (Code : Result_Code) return String;

This function returns the textual representation of Code.

LDAP_Error : exception;

This is an exception used to indicate LDAP specific errors.

17.19.2. LDAP middle-level interface

The middle-level LDAP_Peer interface operates on the message level. A request or response can be set into LDAP_Message directly.

NOTE. When forming requests and responses the component Buffer must be erased by calling Erase which is used to hold ASN.1 data. The higher-level operations do this automatically.

procedure Send_Request
          (  Peer : in out LDAP_Peer;
             ID   : Integer_32
          );

This procedure sends the request set in the output message Peer.Output.Message. The message is formed using LDAP_Message interface. ID identifies the request. It is increased with each new request. Only clients should use this procedure. Data_Error is propagated if there is no place in the outgoing buffer. The buffer size is controlled by the discriminant Output_Size. Use Set_Overlapped_Size to control how the output buffer is used. Socket_Error is propagated on I/O errors.

procedure Reply_Response (Peer : in out LDAP_Peer);

This procedure sends the response set in the output message Peer.Output.Message. The message is formed using LDAP_Message interface. The identifier of the reply is taken from the current request. Only servers should use this procedure. Data_Error is propagated if there is no place in the outgoing buffer. Socket_Error is propagated on I/O errors.

 The middle-level interface does not change the value of Message_ID. It must be handled by the server (see Reply_Response) or client (see Send_Request). The operations defined are:

function Get_Search_Request_Filter
         (  Message : LDAP_Message
         )  return LDAP_Filter_Ptr;

This function returns the search filter set into the message. Use_Error is propagated when the current request in the message is not the search request. The middle-level interface defines operations to modify the currently used filter.

function Set_Abandon_Request
         (  Message : in out LDAP_Message;
            ID      : Integer_32
         );

This function sets the abandon request into the message. ID identifies a request issued earlier to abandon.

function Set_Add_Attribute
         (  Message     : in out LDAP_Message;
            Descrpition : String;
            Value       : String := ""
         );

This procedure can be called after Set_Add_Request or Set_Search_Result_Entry to add another attribute to the request. Use_Error is propagated neither add request nor search result entry is not set in the message.

function Set_Add_Request
         (  Message     : in out LDAP_Message;
            Name        : Distinguished_Name;
            Descrpition : String;
            Value       : String := ""
         );

This procedure sets the add request into the message. Name is the name of the new entry. Description the attribute of. Value if not empty is the attribute value. Further values can be added using Set_Attribute_Value. More attributes can be added using Set_Add_Attribute.

function Set_Add_Request
         (  Message    : in out LDAP_Message;
            Name       : Distinguished_Name;
            Attributes : Attributes_List
         );

This variant of Set_Add_Request uses a complete attributes list object as a parameter.

function Set_Add_Response
         (  Message     : in out LDAP_Message;
            Code        : Result_Code;
            Matched     : Distinguished_Name := Null_Name;
            Diagnostics : String             := "";
            Referral    : Values_List        := Empty
         );

This procedure sets the add response into the message. Code is the result code.

function Set_Attribute_Value
         (  Message : in out LDAP_Message;
            Value   : String
         );

This procedure can be called after to add another attribute value to the last attribute of the add request or search result entry. Use_Error is propagated neither add request nor search result entry is not set in the message.

function Set_Bind_Request
         (  Message  : in out LDAP_Message;
            Name     : Distinguished_Name;
            Password : String
         );

This procedure sets the simple bind request into the message. Name is the object to bind to. Password is the password.

function Set_Bind_Request
         (  Message     : in out LDAP_Message;
            Name        : Distinguished_Name;
            Mechanism   : String;
            Credentials : String
         );

This procedure sets the SASL bind request into the message. Mechanism specifies the method, e.g. CRAM-MD5. Credentials are the credentials. In an authentication using CRAM-MD5 functions the client sends the bind request without credentials. The bind response returns the challenge. The second bind request has the credentials set to answer the challenge.

function Set_Bind_Response
         (  Message     : in out LDAP_Message;
            Code        : Result_Code;
            Matched     : Distinguished_Name := Null_Name;
            Diagnostics : String             := "";
            Credentials : String             := "";
            Referral    : Values_List        := Empty
         );

This procedure sets the bind response into the message. Code is the result code. Credentials is the bind-specific part that is used by the server to send a challenge to the client.

function Set_Compare_Request
         (  Message     : in out LDAP_Message;
            Name        : Distinguished_Name;
            Description : String;
            Value       : String
         );

This procedure sets the compare request into the message. Name specifies the entry to compare. Description specifies the attribute, Value specifies the attribute value to compare.

function Set_Compare_Response
         (  Message     : in out LDAP_Message;
            Code        : Result_Code;
            Matched     : Distinguished_Name := Null_Name;
            Diagnostics : String             := "";
            Referral    : Values_List        := Empty
         );

This procedure sets the compare response into the message. Code is the result code. There are special codes used to identify match (Compare_True_Code) and mismatch (Compare_False_Code) which are used instead of the success code.

function Set_Delete_Request
         (  Message : in out LDAP_Message;
            Name    : Distinguished_Name
         );

This procedure sets the delete request into the message. Name specifies the entry to delete.

function Set_Delete_Response
         (  Message     : in out LDAP_Message;
            Code        : Result_Code;
            Matched     : Distinguished_Name := Null_Name;
            Diagnostics : String             := "";
            Referral    : Values_List        := Empty
         );

This procedure sets the delete response into the message.

function Set_Extended_Request
         (  Message     : in out LDAP_Message;
            Name        : Distinguished_Name;
            Value       : String
         );

This procedure sets the extended request into the message. The extended request invokes an extended operation beyond the ones defined by the standard and supported by the server. Name specifies the requested name. Value specifies the value.

function Set_Extended_Response
         (  Message     : in out LDAP_Message;
            Code        : Result_Code;
            Matched     : Distinguished_Name := Null_Name;
            Diagnostics : String             := "";
            Name        : Object_Identifier  := (1..0 => 0);
            Value       : String             := "";
            Referral    : Values_List        := Empty
         );

This procedure sets the extended response into the message. Code is the result code. There are two additional to the standard response parameters Name and Value, which the server can use to communicate with the client.

function Set_Intermediate_Response
         (  Message : in out LDAP_Message;
            Name    : Object_Identifier := (1..0 => 0);
            Value   : String            := ""
         );

This procedure sets the intermediate response into the message. The server may send one or several intermediate responses to the client before sending the final response. Name and Value are intermediate results to deliver to the client. The serve not use intermediate responses unless the client explicitly indicates that it is prepared to accept them. Usually it is done by requesting a type of extended operation that may return them.

function Set_Modify_Request
         (  Message     : in out LDAP_Message;
            Name        : Distinguished_Name;
            Operation   : Operation_Type;
            Descrpition : String;
            Value       : String := ""
         );

This procedure sets the modify request into the message. The parameter Name specifies the object to modify. The parameter Operation specifies what should me done:

type Operation_Type is mod 2**8;
Add_Operation     : constant Operation_Type := 0;
Delete_Operation  : constant Operation_Type := 1;
Replace_Operation : constant Operation_Type := 2;

The parameters Description and Value specify parameters for the operation. When Value is empty delete and replace apply to all values. See also Updates_List. Further modifications can be added using Set_Modify_Request_Add_Operation. Set_Modify_Request_Add_Value can be used to add further values to the attribute indicated by Description.

function Set_Modify_Request
         (  Message : in out LDAP_Message;
            Name    : Distinguished_Name;
            Update  : Updates_List
         );

This procedure sets the modify request into the message. The parameter Name specifies the object to modify. The parameter Updates specifies the updates to apply.

function Set_Modify_Request_Add_Operation
         (  Message     : in out LDAP_Message;
            Name        : Distinguished_Name;
            Operation   : Operation_Type;
            Descrpition : String;
            Value       : String := ""
         );

This procedure adds a new operation the modify request set in the message. Use_Error is propagated when modify is not current request set in the message. Set_Modify_Request_Add_Value can be used to add further values to the attribute indicated by Description.

function Set_Modify_Request_Add_Value
         (  Message : in out LDAP_Message;
            Value   : String := ""
         );

This procedure can be called after Set_Modify_Request or Set_Modify_Request_Add_Operation to add another attribute value to the last operation of the modify request. Use_Error is propagated when modify is not current request set in the message.

function Set_Modify_Response
         (  Message     : in out LDAP_Message;
            Code        : Result_Code;
            Matched     : Distinguished_Name := Null_Name;
            Diagnostics : String             := "";
            Referral    : Values_List        := Empty
         );

This procedure sets the modify response into the message. Code is the result code.

function Set_Modify_DN_Request
         (  Message      : in out LDAP_Message;
            Name         : Distinguished_Name;
            New_RDN      : Distinguished_Name;
            Delete_RDN   : Boolean;
          [ New_Superior : Distinguished_Name ]
         );

This procedure sets the name modify request into the message. The parameter Name specifies the name to modify. The parameter New_RDN is the new name. It may be the same as the current name if the entry must be moved to a  new parent. If the New_RDN includes any attribute values that aren’t already in the entry, the entry will be updated to include them. When Delete_RDN is true  any attribute values from the entry that were in the original name but not in the new name are deleted. New_Superior is the new parent for the entry, when specified.

function Set_Modify_DN_Response
         (  Message     : in out LDAP_Message;
            Code        : Result_Code;
            Matched     : Distinguished_Name := Null_Name;
            Diagnostics : String             := "";
            Referral    : Values_List        := Empty
         );

This procedure sets the name modify response into the message. Code is the result code.

function Set_Response_Referral
         (  Message : in out LDAP_Message;
            URL     : String
         );

This procedure adds a referral URL to the response. Use_Error is propagated when no response was set into the message prior to this case.

function Set_Response_Referral
         (  Message : in out LDAP_Message;
            URLs    : Values_List
         );

This procedure adds a list of referral URLs to the response. Use_Error is propagated when no response was set into the message prior to this case.

function Set_Search_Result_Done
         (  Message     : in out LDAP_Message;
            Code        : Result_Code;
            Matched     : Distinguished_Name := Null_Name;
            Diagnostics : String             := "";
            Referral    : Values_List        := Empty
         );

This procedure sets the search entry response into the message. This is the final response in the series. See Set_Search_Result_Entry and Set_Search_Result_Reference. Code is the result code.

function Set_Search_Result_Entry
         (  Message     : in out LDAP_Message;
            Name        : Distinguished_Name;
            Descrpition : String;
            Value       : String := ""
         );

This procedure sets the search entry response into the message. Name is the entry name. Description is the attribute description. This procedure adds the first attribute value if Value is not empty. Further values can be added using Set_Attribute_Value. More attributes can be added using Set_Add_Attribute.

function Set_Search_Result_Entry
         (  Message    : in out LDAP_Message
            Name       : Distinguished_Name;
            Attributes : Attributes_List
         );

This variant of Set_Search_Result_Entry uses a complete attributes list object as a parameter.

function Set_Search_Result_Reference
         (  Message : in out LDAP_Message
            URI     : String
         );

This procedure sets the search reference response into the message. URI is the first reference URI in the response. Further reference can be added using Set_Search_Result_Reference_URI.

function Set_Search_Result_Reference
         (  Message : in out LDAP_Message
            URIs    : Values_List
         );

This procedure sets the search reference response into the message. URIs is the list of URI to set into the response.

function Set_Search_Result_Reference_URI
         (  Message : in out LDAP_Message
            URI     : String
         );

This procedure adds an URI to the result. Use_Error is propagated when the search result reference is not set in the message.

function Set_Search_Request
         (  Message       : in out LDAP_Message;
            Name          : Distinguished_Name;
            Filter        : Search_Filter;
            Scope         : Scope_Type       := Whole_Subtree_Scope;
            Aliasing_Mode : Dereference_Type := Deref_Always;
            Size_Limit    : Integer_32       := 0;
            Time_Limit    : Duration         := 0.0;
            Types_Only    : Boolean          := False
         );

This procedure sets the search request into the message. The parameter Name specifies where the search starts at. Filter is the search filter. Scope is the scope of search:

type Scope_Type is mod 2**8;
Base_Object_Scope   : constant Scope_Type := 0;
Single_Level_Scope  : constant Scope_Type := 1;
Whole_Subtree_Scope : constant Scope_Type := 2;
Subordinate_Subtree : constant Scope_Type := 3;

Subordinate_Subtree is same as Whole_Subtree_Scope but excludes the entry Name. The parameter Aliasing_Mode specifies how to handle aliases:

type Dereference_Type is mod 2**8;
Never_Deref_Aliases    : constant Dereference_Type := 0;
Deref_In_Searching     : constant Dereference_Type := 1;
Deref_Finding_Base_Obj : constant Dereference_Type := 2;
Deref_Always           : constant Dereference_Type := 3;

The values are:

The parameter Size_Limit specifies the upper limit of the entries returned to the client. Zero value means no limit. The parameter Time_Limit specifies the time limit for the server to search and sending found entries. Types_Only if true indicates that the server should not include attribute values in the response.

function Set_Search_Request
         (  Message       : in out LDAP_Message;
            Name          : Distinguished_Name;
            Present       : String;
            Scope         : Scope_Type       := Whole_Subtree_Scope;
            Aliasing_Mode : Dereference_Type := Deref_Always;
            Size_Limit    : Integer_32       := 0;
            Time_Limit    : Duration         := 0.0;
            Types_Only    : Boolean          := False
         );

This variant of Set_Search_Request sets the search request into the message with an attribute presence filter.

function Set_Search_Request
         (  Message       : in out LDAP_Message;
            Name          : Distinguished_Name;
            Description   : String;
            Comparison    : Comparison_Type;
            Value         : String;
            Scope         : Scope_Type       := Whole_Subtree_Scope;
            Aliasing_Mode : Dereference_Type := Deref_Always;
            Size_Limit    : Integer_32       := 0;
            Time_Limit    : Duration         := 0.0;
            Types_Only    : Boolean          := False
         );

This variant of Set_Search_Request sets the search request into the message with a attribute comparison filter. The parameter Comparison specifies the operation to use:

type Comparison_Type is
     (  Less_Or_Equal,
        Equal,
        Approximately_Equal,
        Greater_Or_Equal
     );

The parameters Description and Value specify the attribute and the value to compare with.

function Set_Search_Request
         (  Message       : in out LDAP_Message;
            Name          : Distinguished_Name;
            Description   : String;
            Component     : Substring_Component_Type;
            Value         : String;
            Scope         : Scope_Type       := Whole_Subtree_Scope;
            Aliasing_Mode : Dereference_Type := Deref_Always;
            Size_Limit    : Integer_32       := 0;
            Time_Limit    : Duration         := 0.0;
            Types_Only    : Boolean          := False
         );

This variant of Set_Search_Request sets the search request into the message with a substring matching filter. The parameter Component specifies the substring location:

type Substring_Component_Type is
     (  Initial_Component, -- Anchored to the string beginning
        Any_Component,     -- Any string location
        Final_Component    -- Anchored to the string end
     );

The parameters Description and Value specify the attribute and the value to compare with. Further operations can be added using Set_Search_Request_Substring.

function Set_Search_Request
         (  Message       : in out LDAP_Message;
            Name          : Distinguished_Name;
            Value         : String;
            Rule          : String;
            Description   : String           := "";
            Attributes    : Boolean          := False;
            Scope         : Scope_Type       := Whole_Subtree_Scope;
            Aliasing_Mode : Dereference_Type := Deref_Always;
            Size_Limit    : Integer_32       := 0;
            Time_Limit    : Duration         := 0.0;
            Types_Only    : Boolean          := False
         );

This variant of Set_Search_Request sets the search request into the message with a extended match filter. The parameters Value, Rule, Description, Attributes have same meaning.

function Set_Search_Request_Conjunction
         (  Message       : LDAP_Message;
            Name          : Distinguished_Name;
            Scope         : Scope_Type       := Whole_Subtree_Scope;
            Aliasing_Mode : Dereference_Type := Deref_Always;
            Size_Limit    : Integer_32       := 0;
            Time_Limit    : Duration         := 0.0;
            Types_Only    : Boolean          := False
         )  return LDAP_Filter_Ptr;
procedure Set_Search_Request_Conjunction
          (  Message       : in out LDAP_Message;
             Name          : Distinguished_Name;
             Scope         : Scope_Type       := Whole_Subtree_Scope;
             Aliasing_Mode : Dereference_Type := Deref_Always;
             Size_Limit    : Integer_32       := 0;
             Time_Limit    : Duration         := 0.0;
             Types_Only    : Boolean          := False
          );

These variants of Set_Search_Request sets the search request into the message with a conjunction filter. The resulting filter is the result of the function and can be modified afterwards. If the conjunction filter remains empty it matches always successfully. Conjunctive terms can be added using Append_Term.

function Set_Search_Request_Disjunction
         (  Message       : LDAP_Message;
            Name          : Distinguished_Name;
            Scope         : Scope_Type       := Whole_Subtree_Scope;
            Aliasing_Mode : Dereference_Type := Deref_Always;
            Size_Limit    : Integer_32       := 0;
            Time_Limit    : Duration         := 0.0;
            Types_Only    : Boolean          := False
         )  return LDAP_Filter_Ptr;
procedure Set_Search_Request_Disjunction
          (  Message       : in out LDAP_Message;
             Name          : Distinguished_Name;
             Scope         : Scope_Type       := Whole_Subtree_Scope;
             Aliasing_Mode : Dereference_Type := Deref_Always;
             Size_Limit    : Integer_32       := 0;
             Time_Limit    : Duration         := 0.0;
             Types_Only    : Boolean          := False
          );

These variants of Set_Search_Request sets the search request into the message with a disjunction filter. The resulting filter is the result of the function and can be modified afterwards. If the disjunction filter remains empty it never matches successfully. Disjunctive terms can be added using Append_Term.

function Set_Search_Request_Negation
         (  Message       : LDAP_Message;
            Name          : Distinguished_Name;
            Scope         : Scope_Type       := Whole_Subtree_Scope;
            Aliasing_Mode : Dereference_Type := Deref_Always;
            Size_Limit    : Integer_32       := 0;
            Time_Limit    : Duration         := 0.0;
            Types_Only    : Boolean          := False
         )  return LDAP_Filter_Ptr;

These variants of Set_Search_Request sets the search request into the message with a negation filter. The result must be modified to set the negation argument.

procedure Set_Search_Request_Substring
          (  Message   : LDAP_Message;
             Component : Substring_Component_Type;
             Value     : String
          );

This procedure adds a new substring matching operation to the current substring matching filter. Use_Error is propagated when search is not current request set or the filter is not substring.

procedure Set_Unbind_Request (Message : LDAP_Message);

This procedure set the unbind request into the message.

Middle-level filter operations. Filter is a part of the LDAP_Message declaring following RFC 4511:

type LDAP_Filter is new ASN1.Choices.Choice_Data_Item with record
   And_Filter       : LDAP_Filter_Set;
   Or_Filter        : LDAP_Filter_Set;
   Not_Filter       : LDAP_Filter_Item;
   Equality_Match   : LDAP_Implicit_Attribute_Value_Assertion;
   Substrings       : LDAP_Substring_Filter;
   Greater_Or_Equal : LDAP_Implicit_Attribute_Value_Assertion;
   Less_Or_Equal    : LDAP_Implicit_Attribute_Value_Assertion;
   Present          : LDAP_Implicit_String;
   Approx_Match     : LDAP_Implicit_Attribute_Value_Assertion;
   Extensible_Match : LDAP_Matching_Rule_Assertion;
end record;
type LDAP_Filter_Ptr is access all LDAP_Filter;

The following operations are defined on LDAP_Filter:

procedure Append
          (  Filter    : in out LDAP_Filter;
             Component : Substring_Component_Type;
             Value     : String
          );

This procedure adds a new substring matching operation to the current substring matching filter. Use_Error is propagated when Filter is not substring matching filter.

function Append_Term
         (  Filter : access LDAP_Filter
         )  return LDAP_Filter_Ptr;

This procedure adds a new conjunctive or disjunctive term to the current filter. Use_Error is propagated when Filter is not a conjunction or disjunction filter.

function Conjunction_Size (Filter : LDAP_Filter) return Natural;

This function returns the current number of conjunctive terms. Use_Error is propagated when Filter is not a conjunction filter.

function Disjunction_Size (Filter : LDAP_Filter) return Natural;

This function returns the current number of disjunctive terms. Use_Error is propagated when Filter is not a disjunction filter.

function Get_Conjunction_Term
         (  Filter : LDAP_Filter;
            Index  : Positive
         )  return LDAP_Filter_Ptr;

This function returns a conjunctive term of Filter by its index in the range 1..Conjunction_Size. Use_Error is propagated when Filter is not a conjunction filter. Constraint_Error is propagated when Index is out of range.

function Get_Disjunction_Term
         (  Filter : LDAP_Filter;
            Index  : Positive
         )  return LDAP_Filter_Ptr;

This function returns a disjunctive term of Filter by its index in the range 1..Disjunction_Size. Use_Error is propagated when Filter is not a disjunction filter. Constraint_Error is propagated when Index is out of range.

function Get_Negation_Term
         (  Filter : LDAP_Filter
         )  return LDAP_Filter_Ptr;

This function returns the argument of the negation. Use_Error is propagated when Filter is not a negation filter. The result is null when the argument is unset.

procedure Set
          (  Filter  : in out LDAP_Filter;
             Present : String
          );

This procedure sets the filter to match presence of an attribute.

procedure Set
          (  Filter      : in out LDAP_Filter;
             Description : String;
             Comparison  : Comparison_Type;
             Value       : String;
          );

This procedure sets the filter to attribute comparison filter. The parameter Comparison specifies the operation to use. The parameters Description and Value specify the attribute and the value to compare with.

procedure Set
          (  Filter      : in out LDAP_Filter;
             Description : String;
             Component   : Substring_Component_Type;
             Value       : String;
          );

This procedure sets the filter to the substring matching filter. The parameter Component specifies the substring location. The parameters Description and Value specify the attribute and the value to compare with.

procedure Set
          (  Filter      : in out LDAP_Filter;
             Value       : String;
             Rule        : String;
             Description : String  := "";
             Attributes  : Boolean := False;
          );

This procedure sets the filter to the extended match filter. The parameters Value, Rule, Description, Attributes have same meaning.

function Set_Conjunction
         (  Filter : access LDAP_Filter
         )  return LDAP_Filter_Ptr;
procedure Set_Conjunction (Filter : in out LDAP_Filter);

This procedure sets the filter to a conjunction of filters. All terms must match. Further terms are added using Append_Term. The first term is added and returned. If called consecutively each call adds a new term. The procedure variant does not add any terms.

function Set_Disjunction
         (  Filter : access LDAP_Filter
         )  return LDAP_Filter_Ptr;
procedure Set_Disjunction (Filter : in out LDAP_Filter);

This procedure sets the filter to a disjunction of filters. All terms must match. Further terms are added using Append_Term. The first term is added and returned. If called consecutively each call adds a new term. The procedure variant does not add any terms.

function Set_Negation
         (  Filter : access LDAP_Filter
         )  return LDAP_Filter_Ptr;

This function sets the filter to the negation of a filter. The filter must not match is argument to succeed. The argument filter is returned as the result.

17.19.3. Values list

The package GNAT.Sockets.Connection_State_Machine.LDAP defines a helper type to construct lists of attribute values:

type Values_List (<>) is private;

A list of values can be constructed as follows:

"First element" / "Second element"

The following operations are defined:

function Get_Length (List : Values_List) return Natural;

This function returns the length of List.

function Get (List : Values_List; Index : Positive) return String;

This function returns the list element by its index in 1..Get_Length. Constraint_Error is propagated when the index is out of range.

function "/" (Left : String; Right : String) return Values_List;
function
"/" (Left : Values_List; Right : String) return Values_List;

These functions concatenate lists.

function Empty return Values_List;

This function returns an empty list.

function "+" (Value : String) return Values_List;

This function creates list with the single element Value.

17.19.4. Attributes and lists of

The package GNAT.Sockets.Connection_State_Machine.LDAP defines a helper type to construct lists of attributes. An attribute has description and a list of values:

type Attribute_Definition (<>) is private;

An attribute can be constructed as follows:

"objectClass" - "top"/"domain"

The following operations are defined:

function "-"
         (  Description : String;
            Value       : String
         )  return Attribute_Definition;
function
"-"
         (  Description : String;
            Values      : Values_List
         )  return Attribute_Definition;

These functions create an attribute from description and a value or a list of values.

type Attributes_List (<>) is private;

An attributes list can be constructed as follows:

"objectClass" - "top"/"domain" or "dc" - "example"

The following operations are defined:

function Get_Length (List : Attributes_List) return Natural;

This function returns the length of List.

function Get_Description
         (  List  : Attributes_List;
            Index : Positive
         )  return String;

This function returns the description a list element by the element index in 1..Get_Length. Constraint_Error is propagated when the index is out of range.

function Get_Values
         (  List  : Attributes_List;
            Index : Positive
         )  return Values_List;

This function returns the values of a list element by the element index in 1..Get_Length. Constraint_Error is propagated when the index is out of range.

function "-"
         (  Description : String;
            Value       : String
         )  return Attributes_List;
function
"-"
         (  Description : String;
            Values      : Values_List
         )  return Attributes_List;

These functions create a singleton list from attribute description and attribute value or values list.

function "or" (Left, Right : Attributes_List) return Attributes_List;

These functions concatenate lists.

17.19.5. Update list

The package GNAT.Sockets.Connection_State_Machine.LDAP defines a type describing an LDAP update:

type Updates_List (<>) is private;

An update list can be constructed as follows:

Add ("objectClass" - "top"/"domain") or Delete ("dc" - "example")

The following operations are defined:

function Add
         (  Attribute : Attribute_Definition
         )  return Updates_List;

This function returns an update that adds a new attribute or new values to the attribute existing attribute.

function Delete
         (  Attribute : Attribute_Definition
         )  return Updates_List;

This function returns an update that deletes values of an attribute or all attribute when all values are deleted.

function Delete_All
         (  Description : String
         )  return Updates_List;

This function returns an update that deletes the attribute specified by the parameter Description.

function Replace
         (  Attribute : Attribute_Definition
         )  return Updates_List;

This function returns an update that replaces values of an attribute. All values that are not in the list of values are removed, only the values specified by Attribute will be present.

function Replace_All
         (  Description : String
         )  return Updates_List;

This function returns an update that deletes the attribute if it exists.

function "or" (Left, Right : Updates_List) return Updates_List;

These functions concatenate lists.

17.19.6. Search filters

The package GNAT.Sockets.Connection_State_Machine.LDAP defines a filter type used in search requests:

type Search_Filter (<>) is private;

A search filter can be constructed as follows:

Add ("objectClass" - "top"/"domain") or Delete ("dc" - "example")

Attribute value comparison:

function "="  (Description, Value : String) return Search_Filter;
function
"<=" (Description, Value : String) return Search_Filter;
function
">=" (Description, Value : String) return Search_Filter;
function
Like (Description, Value : String) return Search_Filter;

These functions return a filter that compares value of an attribute specified by the parameter Description with Value. The function Like creates a filter that performs approximate value match.

Attribute presence check:

function Present (Description : String) return Search_Filter;

This function returns a filter that checks if an attribute is present. For example:

Present ("objectClass")

is typically used to enumerate attributes of an object.

Matching substrings of attribute values:

type Substring_Filter (<>) is private;

This type describes a substring partial filter:

function Prefix (Value : String) return Substring_Filter;

This function returns a partial filter that matches prefix of a value. It is equivalent to the wild-card pattern <value>*.

function Substring (Value : String) return Substring_Filter;

This function returns a partial filter that matches any value substring. It is equivalent to the wild-card pattern *<value>*.

function Suffix (Value : String) return Substring_Filter;

This function returns a partial filter that matches suffix of value. It is equivalent to the wild-card pattern *<value>.

function "/" (Left, Right : Substring_Filter) return Substring_Filter;

This function combines two partial substring filters. The resulting filter matches the attribute value if either of its parts does.

function "="
         (  Description : String;
            Substrings  : Substring_Filter
         )  return Search_Filter;

This function creates a filter that matches values of the attribute specified by Description using the partial substring filter Substrings. For example:

"givenName" = Prefix ("Jo") / Suffix ("n")

This filter matches attribute givenName if it has a value that starts with Jo and ends with n.

Extended match.

function Extended
         (  Value       : String;
            Rule        : String;
            Description : String  := "";
            Attributes  : Boolean := False
         )  return Search_Filter;

This function returns a filter that performs extended match:

Logical lattice. Filters can be combined using logical operations:

an update that deletes the attribute specified by the parameter Description.

function Failure return Search_Filter;
function
Success return Search_Filter;
function
"and" (Left, Right : Search_Filter) return Search_Filter;
function
"or"  (Left, Right : Search_Filter) return Search_Filter;
function
"not" (Left : Search_Filter) return Search_Filter;

17.19.7. Low-level interface

The package GNAT.Sockets.Connection_State_Machine.LDAP declares the type LDAP_Message (following ASN.1 declarations of RFC 4511). The message can be formed by settings the components of the type. It can be then encoded using a call to Encode:

type LDAP_Output
     (  Message_Length : Stream_Element_Count;
        Size           : Positive
     )  is new Ada.Finalization.Limited_Controlled with
record

   Message : LDAP_Message;
   Request : Stream_Element_Array (1..Message_Length);
   Buffer  : aliased External_String_Buffer (Size);
end record
;

The field request is the buffer to use with Encode. When a query is received it is stored in the input Message and the peer can inspect its components directly.The LDAP_Message is declared as:

type LDAP_Message is new Tagged_Sequence_Data_Item with record
   Message_ID  : ASN1.Integers_32.Implicit_Integer_Data_Item;
   Protocol_Op : LDAP_Operation;
   Control     : LDAP_Control;
end record;

The LDAP_Operation is declared as:

type LDAP_Operation is new ASN1.Choices.Choice_Data_Item with record
   Bind_Request            : LDAP_Bind_Request;
   Bind_Response           : LDAP_Bind_Response;
   Unbind_Request          : ASN1.Nulls.Implicit_Null_Data_Item;
   Search_Request          : LDAP_Search_Request;
   Search_Result_Entry     : LDAP_Search_Result_Entry;
   Search_Result_Done      : LDAP_Result;
   Search_Result_Reference : LDAP_Implicit_String_Sequence;
   Modify_Request          : LDAP_Modify_Request;
   Modify_Response         : LDAP_Result;
   Add_Request             : LDAP_Add_Request;
   Add_Response            : LDAP_Result;
   Delete_Request          : LDAP_Implicit_DN;
   Delete_Response         : LDAP_Result;
   Modify_DN_Request       : LDAP_Modify_DN_Request;
   Modify_DN_Response      : LDAP_Result;
   Compare_Request         : LDAP_Compare_Request;
   Compare_Response        : LDAP_Result;
   Abandon_Request         : LDAP_Abandon_Request;
   Extended_Request        : LDAP_Extended_Request;
   Extended_Response       : LDAP_Extended_Response;
   Intermediate_Response   : LDAP_Intermediate_Response;
end record;

The components of this type are individual requests and responses.

type LDAP_Add_Request is
   new
Implicit_Sequence_Data_Item with
record

   Entry_Item : LDAP_DN;
   Attributes : LDAP_Attribute_List;
end record
;

This type describes the parameters of add request.

type LDAP_Compare_Request is
   new
Implicit_Sequence_Data_Item with
record

   Entry_Item                : LDAP_DN;
   Attribute_Value_Assertion : LDAP_Attribute_Value_Assertion;
end record
;

This type describes the parameters of compare request.

type LDAP_Modify_Request is
   new
Implicit_Sequence_Data_Item with
record

   Object  : LDAP_DN;
   Changes : LDAP_Operations_List;
end record
;

This type describes the parameters of modify request.

type LDAP_Modify_DN_Request is
   new
Implicit_Sequence_Data_Item with
record

   Entry_Item     : LDAP_Implicit_DN;
   New_RDN        : LDAP_Implicit_DN;
   Delete_Old_RDN : ASN1.Booleans.Implicit_Boolean_Data_Item;
   New_Superior   : LDAP_Implicit_DN;
end record
;

This type describes the parameters of modify DN request.

type LDAP_Search_Request is
   new
ASN1.Sequences.Implicit_Sequence_Data_Item with
record

   Base_Object   : LDAP_DN;
   Scope         : LDAP_Scopes.Enumeration_Data_Item;
   Deref_Aliases : LDAP_Derefs.Enumeration_Data_Item;
   Size_Limit    : ASN1.Integers_32.Integer_Data_Item;
   Time_Limit    : ASN1.Integers_32.Integer_Data_Item;
   Types_Only    : ASN1.Booleans.Boolean_Data_Item;
   Filter        : aliased LDAP_Filter;
   Attributes    : LDAP_String_Sequence;
end record
;

This type describes the parameters of search request.

17.19.8. LDAP server

The package GNAT.Sockets.Connection_State_Machine.LDAP.Server provides a higher-level LDAP server interface:

type LDAP_Server is new LDAP_Peer with private;

The type derived from this base type must implement the callbacks to the client requests.

Requests callbacks. The callback parameters are decoded when they are straightforward. Otherwise the request object is passed without decoding to reduce the overhead. The following primitive operations are the request callbacks:

procedure Receive_Abandon_Request
          (  Server : in out LDAP_Server;
             ID     : Integer_32
          );

This procedure is called when the client is no longer interested in response to a request it earlier made. The request is identified by its number ID. This request has no response. The default implementation does nothing.

procedure Receive_Add_Request
          (  Server  : in out LDAP_Server;
             Request : LDAP_Add_Request
          );

This procedure is called when the client requests creation of a new entry. The parameter Request is contains the request data. It has the type LDAP_Add_Request. The default implementation responds with Unwilling_To_Perform_Code.

procedure Receive_Bind_Request
          (  Server   : in out LDAP_Server;
             Name     : Distinguished_Name;
             Password : String
          );

This procedure is called when the client makes a simple bind request. Name is the object to bind to. Password is the password. The default implementation responds with Auth_Method_Not_Supported_Code.

procedure Receive_Bind_Request
          (  Server      : in out LDAP_Server;
             Name        : Distinguished_Name;
             Mechanism   : String;
             Credentials : String
          );

This procedure is called when the client makes a SASL bind request. Name is the object to bind to. Mechanism is the method to use, e.g. CRAM-MD5. Credentials contains whatever credentials required. The initial request usually has no credentials and the server replies with the challenge back. The second request contains the credentials for the challenge. The default implementation responds with Auth_Method_Not_Supported_Code.

procedure Receive_Compare_Request
          (  Server  : in out LDAP_Server;
             Request : LDAP_Compare_Request
          );

This procedure is called when the client requests comparison. The parameter Request is contains the request data. It has the type LDAP_Compare_Request. The default implementation responds with Unwilling_To_Perform_Code.

procedure Receive_Delete_Request
          (  Server : in out LDAP_Server;
             Name   : Distinguished_Name
          );

This procedure is called when the client requests deletion of an entry. The parameter Name specifies the name of the entry to delete. The default implementation responds with Unwilling_To_Perform_Code.

procedure Receive_Extended_Request
          (  Server : in out LDAP_Server;
             Name   : Object_Identifier;
             Value  : String
          );

This procedure is called when the client requests deletion of an entry. The parameters Name and Value are specific to the extension request. The default implementation responds with Unwilling_To_Perform_Code.

procedure Receive_Modify_Request
          (  Server  : in out LDAP_Server;
             Request : LDAP_Modify_Request
          );

This procedure is called when the client requests modification of an entry. The parameter Request is contains the request data. It has the type LDAP_Modify_Request. The default implementation responds with Unwilling_To_Perform_Code.

procedure Receive_Modify_DN_Request
          (  Server  : in out LDAP_Server;
             Request : LDAP_Modify_DN_Request
          );

This procedure is called when the client requests modification of a name. The parameter Request is contains the request data. It has the type LDAP_Modify_DN_Request. The default implementation responds with Unwilling_To_Perform_Code.

procedure Receive_Search_Request
          (  Server  : in out LDAP_Server;
             Request : LDAP_Search_Request
          );

This procedure is called when the client requests a search. The parameter Request is contains the request data. It has the type LDAP_Search_Request. The default implementation responds with Unwilling_To_Perform_Code.

procedure Receive_Unbind_Request
          (  Server : in out LDAP_Server
          );

This procedure is called when the client requests unbind. The default implementation does nothing.

Server responses. The server can use low-level interface to form its response in Peer.Output.Message and then call Reply_Response. Alternatively the following higher-level reply sending operations can be used:

procedure Reply_Add
          (  Server   : in out LDAP_Server;
             Result   : Result_Code;
             Matched  : Distinguished_Name := Null_Name;
             Message  : String             := "";
             Referral : Values_List        := Empty
          );

This procedure sends add response to the client. Result is the result code. Matched identifies a related entry if necessary. Message is the diagnostics message. Referral is a list of URI the client could make use of.

Exceptions
Socket_Error I/O error
Status_Error The connection is down
Data_Error Protocol error
LDAP_Error Any LDAP-specific error

procedure Reply_Bind
          (  Server      : in out LDAP_Server;
             Result      : Result_Code;
           [ Credentials : String; ]
             Matched     : Distinguished_Name := Null_Name;
             Message     : String             := "";
             Referral    : Values_List        := Empty
          );

This procedure sends bind response to the client. Result is the result code. For a SASL authentication Credentials is usually used to send the challenge to the client. Matched identifies a related entry if necessary. Message is the diagnostics message. Referral is a list of URI the client could make use of.

Exceptions
Socket_Error I/O error
Status_Error The connection is down
Data_Error Protocol error
LDAP_Error Any LDAP-specific error

procedure Reply_Compare
          (  Server   : in out LDAP_Server;
             Result   : Result_Code;
             Matched  : Distinguished_Name := Null_Name;
             Message  : String             := "";
             Referral : Values_List        := Empty
          );

This procedure sends compare response to the client. Result is the result code. The compare response uses Compare_False_Code and Compare_True_Code to indicate mismatch and match. Matched identifies a related entry if necessary. Message is the diagnostics message. Referral is a list of URI the client could make use of.

Exceptions
Socket_Error I/O error
Status_Error The connection is down
Data_Error Protocol error
LDAP_Error Any LDAP-specific error

procedure Reply_Delete
          (  Server   : in out LDAP_Server;
             Result   : Result_Code;
             Matched  : Distinguished_Name := Null_Name;
             Message  : String             := "";
             Referral : Values_List        := Empty
          );

This procedure sends delete response to the client. Result is the result code. Matched identifies a related entry if necessary. Message is the diagnostics message. Referral is a list of URI the client could make use of.

Exceptions
Socket_Error I/O error
Status_Error The connection is down
Data_Error Protocol error
LDAP_Error Any LDAP-specific error

procedure Reply_Extended
          (  Server   : in out LDAP_Server;
             Result   : Result_Code;
             Name     : Object_Identifier;
             Value    : String;
             Matched  : Distinguished_Name := Null_Name;
             Message  : String             := "";
             Referral : Values_List        := Empty
          );

This procedure sends extended request response to the client. Result is the result code. The parameters Name and Value are extended response data which meaning depend on the request. Matched identifies a related entry if necessary. Message is the diagnostics message. Referral is a list of URI the client could make use of.

Exceptions
Socket_Error I/O error
Status_Error The connection is down
Data_Error Protocol error
LDAP_Error Any LDAP-specific error

procedure Reply_Intermediate
          (  Server : in out LDAP_Server;
             Name   : Object_Identifier;
             Value  : String
          );

This procedure sends an intermediate response to the client. The parameters Name and Value are the data sent to the client before completing the original client's request. The server may return any number of intermediate response messages in response to any of the client's requests, but only where the client explicitly indicated that it is prepared to accept them.

Exceptions
Socket_Error I/O error
Status_Error The connection is down
Data_Error Protocol error
LDAP_Error Any LDAP-specific error

procedure Reply_Modify
          (  Server   : in out LDAP_Server;
             Result   : Result_Code;
             Matched  : Distinguished_Name := Null_Name;
             Message  : String             := "";
             Referral : Values_List        := Empty
          );

This procedure sends modify response to the client. Result is the result code. Matched identifies a related entry if necessary. Message is the diagnostics message. Referral is a list of URI the client could make use of.

Exceptions
Socket_Error I/O error
Status_Error The connection is down
Data_Error Protocol error
LDAP_Error Any LDAP-specific error

procedure Reply_Modify_DN
          (  Server   : in out LDAP_Server;
             Result   : Result_Code;
             Matched  : Distinguished_Name := Null_Name;
             Message  : String             := "";
             Referral : Values_List        := Empty
          );

This procedure sends modify DN response to the client. Result is the result code. Matched identifies a related entry if necessary. Message is the diagnostics message. Referral is a list of URI the client could make use of.

Exceptions
Socket_Error I/O error
Status_Error The connection is down
Data_Error Protocol error
LDAP_Error Any LDAP-specific error

procedure Reply_Search_Done
          (  Server   : in out LDAP_Server;
             Result   : Result_Code;
             Matched  : Distinguished_Name := Null_Name;
             Message  : String             := "";
             Referral : Values_List        := Empty
          );

This procedure sends search done response to the client. This response completes dealing with the search request. Result is the result code. Matched identifies a related entry if necessary. Message is the diagnostics message. Referral is a list of URI the client could make use of.

Exceptions
Socket_Error I/O error
Status_Error The connection is down
Data_Error Protocol error
LDAP_Error Any LDAP-specific error

procedure Reply_Search_Entry
          (  Server     : in out LDAP_Server;
             Name       : Distinguished_Name;
             Attributes : Attributes_List
          );

This procedure sends an intermediate search result to the client. Name is the entry found. Attributes is the attributes of to report to the client.

Exceptions
Socket_Error I/O error
Status_Error The connection is down
Data_Error Protocol error
LDAP_Error Any LDAP-specific error

procedure Reply_Search_Reference
          (  Server : in out LDAP_Server;
             URIs   : Values_List
          );

This procedure sends an intermediate search reference to the client. URIs is the list URI to respond.

Exceptions
Socket_Error I/O error
Status_Error The connection is down
Data_Error Protocol error
LDAP_Error Any LDAP-specific error

Server tracing.

procedure Trace
          (  Server  : in out LDAP_Server;
             Message : String
          );

This procedure is used to perform tracing.

17.19.9. LDAP client

The package GNAT.Sockets.Connection_State_Machine.LDAP.Client provides a higher-level LDAP client interface:

type LDAP_Client is new LDAP_Peer with private;

The type derived from this base type must implement the callbacks to the client requests.

Connection operations.

procedure Cancel (Session : in out LDAP_Client);

The procedure cancels Connect and Wait operations pending in other tasks. The corresponding operations propagate Cancel_Error declared in this package. Note that this has no effect on the communication performed by the client.

procedure Connect
          (  Session        : in out LDAP_Client;
             Host           : String;
             Port           : Port_Type := 389;
             Max_Connect_No : Positive  := Positive'Last;
             Timeout        : Duration  := Duration'Last
          );

The procedure is a synchronous variant of asynchronous Connect. Unlike the latter it awaits for the connection to be established. Timeout is the connection timeout. Timeout_Error, declared in this package, is propagated when the timeout expires. Cancel_Error is propagated when some other tasks calls Cancel. Note that in both cases communication with the target, e.g. connection attempts, is not interrupted or influenced.  Status_Error is propagated when the number of attempts was exhausted. Other errors, e.g. Socket_Error indicate I/O errors.

procedure Wait
          (  Session   : in out LDAP_Client;
             Connected : Boolean;
             Timeout   : Duration := Duration'Last
          );

The procedure awaits the session to become ready for another request when Connected is true. If the connection gets lost an exception is propagated as described below. When Connected is false the procedure waits for any pending request to complete, the connection can be dropped without raising an exception.

Timeout is the connection timeout. Timeout_Error is propagated when the timeout expires. Cancel_Error is propagated when the operation was canceled by another task calling Cancel. Note that in both cases communication with the target is not interrupted or influenced. Status_Error is propagated when the number of attempts was exhausted. Other errors, e.g. Socket_Error indicate I/O errors.

Response callbacks. These operations are called when the server responses to the client. They can be overridden when an additional processing is needed, e.g. when the client uses asynchronous requests. The synchronous requests deliver results directly so the callbacks need not to be used.

procedure Receive_Add_Response
          (  Client   : in out LDAP_Client;
             ID       : Integer_32;
             Result   : Result_Code;
             Matched  : Distinguished_Name;
             Message  : String;
             Referral : Values_List
          );

This procedure is called upon receiving response to an add request. ID is one of the original request. Result is the result code. Matched identifies a related entry if necessary. Message is the diagnostics message. Referral is a list of references sent by the server. The default implementation does nothing.

procedure Receive_Bind_Response
          (  Client      : in out LDAP_Client;
             ID          : Integer_32;
             Result      : Result_Code;
             Matched     : Distinguished_Name;
             Message     : String;
             Referral    : Values_List;
             Credentials : String
          );

This procedure is called upon receiving response to a bindrequest. ID is one of the original request. Result is the result code. Matched identifies a related entry if necessary. Message is the diagnostics message. Referral is a list of references sent by the server could make use of. Credentials is the server's challenge in SASL exchange. The default implementation does nothing.

function Receive_Challenge
         (  Client      : access LDAP_Client;
            Mechanism   : String;
            Matched     : Distinguished_Name;
            Message     : String;
            Credentials : String
         )  return String;

This function is called when synchronous bind request receives a challenge from the server when SASL authentication is used. Mechanism is the authentication mechanism requested. Matched and Message are usually empty. Credentials is the challenge sent by the server. An implementation should return the credentials to be sent back to the server. The default implementation propagates Use_Error.

procedure Receive_Compare_Response
          (  Client   : in out LDAP_Client;
             ID       : Integer_32;
             Result   : Result_Code;
             Matched  : Distinguished_Name;
             Message  : String;
             Referral : Values_List
          );

This procedure is called upon receiving response to a compare request. ID is one of the original request. Result is the result code. Matched identifies a related entry if necessary. Message is the diagnostics message. Referral is a list of references sent by the server. The default implementation does nothing.

procedure Receive_Delete_Response
          (  Client   : in out LDAP_Client;
             ID       : Integer_32;
             Result   : Result_Code;
             Matched  : Distinguished_Name;
             Message  : String;
             Referral : Values_List
          );

This procedure is called upon receiving response to a delete request. ID is one of the original request. Result is the result code. Matched identifies a related entry if necessary. Message is the diagnostics message. Referral is a list of references sent by the server. The default implementation does nothing.

procedure Receive_Extended_Response
          (  Client : in out LDAP_Client;
             ID     : Integer_32;
             Name   : Object_Identifier;
             Value  : String
          );

This procedure is called upon receiving response to an extended request. ID is one of the original request. Result is the result code. Matched identifies a related entry if necessary. Message is the diagnostics message. Referral is a list of references sent by the server. Name and Value are data sent by the server. Their meaning depends on the extension operation. The default implementation does nothing.

procedure Receive_Intermediate_Response
          (  Client : in out LDAP_Client;
             ID     : Integer_32;
             Name   : Object_Identifier;
             Value  : String
          );

This procedure is called upon receiving an intermediate response to some request. ID is one of the original request. Result is the result code. Matched identifies a related entry if necessary. Message is the diagnostics message. Referral is a list of references sent by the server. Name and Value are data sent by the server. The default implementation does nothing.

procedure Receive_Modify_Response
          (  Client   : in out LDAP_Client;
             ID       : Integer_32;
             Result   : Result_Code;
             Matched  : Distinguished_Name;
             Message  : String;
             Referral : Values_List
          );

This procedure is called upon receiving response to a modify request. ID is one of the original request. Result is the result code. Matched identifies a related entry if necessary. Message is the diagnostics message. Referral is a list of references sent by the server. The default implementation does nothing.

procedure Receive_Modify_DN_Response
          (  Client   : in out LDAP_Client;
             ID       : Integer_32;
             Result   : Result_Code;
             Matched  : Distinguished_Name;
             Message  : String;
             Referral : Values_List
          );

This procedure is called upon receiving response to a name modification request. ID is one of the original request. Result is the result code. Matched identifies a related entry if necessary. Message is the diagnostics message. Referral is a list of references sent by the server. The default implementation does nothing.

procedure Receive_Search_Done_Response
          (  Client   : in out LDAP_Client;
             ID       : Integer_32;
             Result   : Result_Code;
             Matched  : Distinguished_Name;
             Message  : String;
             Referral : Values_List
          );

This procedure is called upon receiving last response to a search request. ID is one of the original request. Result is the result code. Matched identifies a related entry if necessary. Message is the diagnostics message. Referral is a list of references sent by the server. The default implementation does nothing.

procedure Receive_Search_Entry_Response
          (  Client     : in out LDAP_Client;
             ID         : Integer_32;
             Name       : Distinguished_Name;
             Attributes : Attributes_List
          );

This procedure is called upon receiving an intermediate response to a search request. ID is one of the original request. Name is a found name. Attributes is the list of attributes. The default implementation does nothing.

procedure Receive_Search_Reference_Response
          (  Client : in out LDAP_Client;
             ID     : Integer_32;
             URIs   : Values_List
          );

This procedure is called upon receiving an intermediate response to a search request. ID is one of the original request. URIs is a list of references sent by the server. The default implementation does nothing.

Sending requests. The client can issue a request synchronously and asynchronously. A synchronous request specifies an execution timeout. The call wait for completion, successful or not. Unsuccessful completion propagates an exception. Successful completion returns an execution result as returned by the server. An asynchronous request returns immediately after queuing it out for sending. The client should use receive callbacks in order to get at the results returned by the server.

function Exists
         (  Client  : LDAP_Client;
            Name    : Distinguished_Name;
            Timeout : Duration := Duration'First
         )  return Boolean;

This function is a wrapper around Send_Search used to check if a name exists.

Exceptions
Socket_Error I/O error
Status_Error The connection is down
Data_Error Protocol error
LDAP_Error Any LDAP-specific error

procedure Send_Abandon
          (  Client : in out LDAP_Client;
             ID     : Integer_32
          );

This procedure sends an abandon request. ID specifies an earlier request to drop. Since server never responds to this request its execution is always asynchronous.

Exceptions
Socket_Error I/O error
Status_Error The connection is down
Data_Error Protocol error
LDAP_Error Any LDAP-specific error

procedure Send_Add
          (  Client     : in out LDAP_Client;
             Name       : Distinguished_Name;
             Attributes : Attributes_List;
             Timeout    : Duration := Duration'First
          );

This procedure sends an add entry request. Name specifies the entry to add. Attributes are the attributes of the entry.

Exceptions
Socket_Error I/O error
Status_Error The connection is down
Data_Error Protocol error
LDAP_Error Any LDAP-specific error

procedure Send_Bind
          (  Client   : in out LDAP_Client;
             Name     : Distinguished_Name;
             Password : String;
             Timeout  : Duration := Duration'First
          );

This procedure sends a simple bind request. Name specifies the entry to bind to. Password is the password.

Exceptions
Socket_Error I/O error
Status_Error The connection is down
Data_Error Protocol error
LDAP_Error Any LDAP-specific error

procedure Send_Bind
          (  Client      : in out LDAP_Client;
             Name        : Distinguished_Name;
             Mechanism   : String;
             Credentials : String   := "";
             Timeout     : Duration := Duration'First
          );

This procedure sends a SASL bind request. Name specifies the entry to bind to. Mechanism specifies the authentication mechanism, e.g. CRAM-MD5. Credentials are usually empty when the first request is made. The server respond with a challenge response. When the call was synchronous Receive_Challenge is called, which can send Send_Bind again with proper parameters. Note that the nested bind request must be asynchronous.

Exceptions
Socket_Error I/O error
Status_Error The connection is down
Data_Error Protocol error
LDAP_Error Any LDAP-specific error

procedure Send_Compare
          (  Client      : in out LDAP_Client;
             Name        : Distinguished_Name;
             Description : String;
             Value       : String
          );
function
Send_Compare
         (  Client      : in out LDAP_Client;
            Name        : Distinguished_Name;
            Description : String;
            Value       : String;
            Timeout     : Duration
         )  return Boolean;

The procedure sends an asynchronous compare request. The function sends a synchronous request and returns the comparison result. Name specifies the entry to compare. Description specifies the attribute which value must be compared. Value is the attribute value to compare.

Exceptions
Socket_Error I/O error
Status_Error The connection is down
Data_Error Protocol error
LDAP_Error Any LDAP-specific error

procedure Send_Delete
          (  Client  : in out LDAP_Client;
             Name    : Distinguished_Name;
             Timeout : Duration := Duration'First
          );

The procedure sends delete request. Name is the name of the entry to delete.

Exceptions
Socket_Error I/O error
Status_Error The connection is down
Data_Error Protocol error
LDAP_Error Any LDAP-specific error

procedure Send_Extended
          (  Client  : in out LDAP_Client;
             Name    : Object_Identifier;
             Value   : String;
             Timeout : Duration := Duration'First
          );

The procedure sends extended  request. Name and Value are the request parameters.

Exceptions
Socket_Error I/O error
Status_Error The connection is down
Data_Error Protocol error
LDAP_Error Any LDAP-specific error

procedure Send_Modify
          (  Client  : in out LDAP_Client;
             Name    : Distinguished_Name;
             Update  : Updates_List;
             Timeout : Duration := Duration'First
          );

The procedure sends a modify request. Name specifies the entry to modify. Update is the updates list to apply.

Exceptions
Socket_Error I/O error
Status_Error The connection is down
Data_Error Protocol error
LDAP_Error Any LDAP-specific error

procedure Send_Modify_DN
          (  Client       : in out LDAP_Client;
             Name         : Distinguished_Name;
             New_RDN      : Distinguished_Name;
             Delete_RDN   : Boolean;
           [ New_Superior : Distinguished_Name; ]
             Timeout      : Duration := Duration'First
          );

The procedure sends a name modification request. Name specifies the name to modify. The parameter New_RDN is the new name. It may be the same as the current name if the entry must be moved to a  new parent. If the New_RDN includes any attribute values that aren’t already in the entry, the entry will be updated to include them. When Delete_RDN is true  any attribute values from the entry that were in the original name but not in the new name are deleted. New_Superior is the new parent for the entry, when specified.

Exceptions
Socket_Error I/O error
Status_Error The connection is down
Data_Error Protocol error
LDAP_Error Any LDAP-specific error

procedure Send_Search
          (  Client        : in out LDAP_Client;
             Name          : Distinguished_Name;
             Filter        : Search_Filter;
             Must_Exist    : Boolean          := False;
             Scope         : Scope_Type       := Whole_Subtree_Scope;
             Aliasing_Mode : Dereference_Type := Deref_Always;
             Size_Limit    : Integer_32       := 0;
             Time_Limit    : Duration         := 0.0;
             Types_Only    : Boolean          := False
             Timeout       : Duration         := Duration'First
          );
function Send_Search
         (  Client        : in out LDAP_Client;
            Name          : Distinguished_Name;
            Must_Exist    : Boolean          := False;
            Scope         : Scope_Type       := Whole_Subtree_Scope;
            Aliasing_Mode : Dereference_Type := Deref_Always;
            Size_Limit    : Integer_32       := 0;
            Time_Limit    : Duration         := 0.0;
            Types_Only    : Boolean          := False
            Timeout       : Duration         := Duration'First
         )  return Search_Result;

When the synchronous with timeout is used, the procedure awaits all exchange to complete until the server sends search result done. The callbacks

are called to accumulate intermediate server responses. The parameter Name specifies where the search starts at. Filter is the search filter. Scope is the scope of search:

Subordinate_Subtree is same as Whole_Subtree_Scope but excludes the entry Name. The parameter Aliasing_Mode specifies how to handle aliases:

The parameter Size_Limit specifies the upper limit of the entries returned to the client. Zero value means no limit. The parameter Time_Limit specifies the time limit for the server to search and sending found entries. Types_Only if true indicates that the server should not include attribute values in the response.

Exceptions
Socket_Error I/O error
Status_Error The connection is down
Data_Error Protocol error
LDAP_Error Any LDAP-specific error

procedure Send_Unbind (Client : in out LDAP_Client);

This procedure sends an unbind request. Since server never responds to this request its execution is always asynchronous.

Exceptions
Socket_Error I/O error
Status_Error The connection is down
Data_Error Protocol error
LDAP_Error Any LDAP-specific error

Server tracing.

procedure Trace
          (  Client  : in out LDAP_Client;
             Message : String
          );

This procedure is used to perform tracing.


[Back][TOC][Next]

18. Packages

[Back][Next]

18.1. Source packages

The following table describes the packages and other compilation units provided by the software.

Package Provides
APQ Implementation packages used for Persistent.APQ
     Common Thicker bindings to the APQ abstracting away data base specific details
  Keys Persistent objects identification in APQ
       Sets Sets of persistent objects keys
  Links Management of persistent objects dependencies in APQ
Backward_Link_Handles An instance of Object.Handle with Backward_Link
  Sets An instance of Object.Handle.Generic_Handle_Set with Backward_Link
Block_Streams Block-oriented I/O layer over a stream
Deposit_Handles An instance of Object.Archived.Handle with Deposit
Gamma Gamma function
Generic_Address_Order Comparison of objects by their addresses
Generic_Chebyshev_Polynomials Chebyshev series (generic)
Generic_B_Tree An implementation of B-tree
Generic_Blackboard One-to-many lock-free generic blackboard
  Generic_Task_Safe Many-to-many generic blackboard with lock-free read access
Generic_Bounded_Map Generic bounded map
Generic_Bounded_Indefinite_Map Generic bounded map of indefinite key and items
Generic_Directed_Graph Generic directed graphs
Generic_Directed_Weighted_Graph Generic directed weighted graphs
Generic_Discrete_Map Generic map of discrete keys
Generic_Discrete_Indefinite_Map Generic map of discrete indefinite keys and indefinite items
Generic_Doubly_Linked Doubly-linked lists of items with referential semantics
Generic_Doubly_Linked_Web Networks of doubly-linked items with referential semantics.
  Generic_List A specialized list view of a network
Generic_FIFO Peer-to-peer lock-free first in, first out generic queue
  Generic_Signaled Peer-to-peer almost lock-free first in, first out generic queue
Generic_Indefinite_B_Tree An implementation of B-tree with indefinite types of keys and objects
Generic_Indefinite_FIFO Peer-to-peer lock-free first in, first out generic queue of indefinite objects
  Generic_Signaled Peer-to-peer almost lock-free first in, first out generic queue of indefinite objects
Generic_Map The type Map
Generic_Random_Sequence Random sequences of non-repeating items
Generic_Set The type Set
Generic_Stack The type Stack, a generic stack
Generic_Segmented_Stack Stacks built of segments of same size (generic)
Generic_Unbounded_Array The type Unbounded_Array and operations on it
Generic_Unbounded_Ptr_Array The type Unbounded_Ptr_Array
GNAT.Sockets GNAT sockets implementation
  Connection_State_Machine Multiple TCP connections server, a higher-level implementation
    ASN1 The base package of ASN.1 implementation
      Bit_Strings An implementation of ASN.1 BIT STRING
          Explicit Explicitly encoded BIT STRING
         Implicit Implicitly encoded BIT STRING
      Booleans An implementation of ASN.1 BOOLEAN
      Choices An implementation of ASN.1 CHOICE
      Dates An implementation of ASN.1 date and time
      Distinguished_Names An implementation of distinguished names on top of ASN.1 strings
      Floats An instantiation of Generic_Real with Float
      Generic_Enumeration A generic implementation of ASN.1 ENUMERATED instantiated by a discrete type
      Generic_Integer A generic implementation of ASN.1 INTEGER instantiated by an integer type
      Generic_Real A generic implementation of ASN.1 REAL instantiated by a float type
      Generic_Unsigned A generic implementation of ASN.1 INTEGER instantiated by a modular type
      Indefinite_Unsigneds An implementation of indefinite length unsigned ASN.1 INTEGER allocated in an external buffer
      Integers An instantiation of Generic_Integer with Integer
      Integers_8 An implementation of ASN.1 INTEGER for Integer_8
      Integers_16 An instantiation of Generic_Integer with Integer_16
      Integers_32 An instantiation of Generic_Integer with Integer_32
      Integers_64 An instantiation of Generic_Integer with Integer_64
      Lengths Encoding and decoding ASN.1 length
      Long_Floats An instantiation of Generic_Real with Long_Float
      Nulls An implementation of ASN.1 NULL
      Objects Any ASN.1 object parsed recursively
      Sequences Implementations of ASN.1 SEQUENCE and SEQUENCE OF
        Explicit Explicitly encoded sequences
        Generic_Sequence_Of A generic implementation of ASN.1 SEQUENCE OF
         Implicit Implicitly encoded sequences
      Sets Implementations of ASN.1 SET, SET OF and singleton sets
         Explicit Explicitly encoded sets
        Generic_Reference A generic dynamically allocated ASN.1 objects (singleton sets)
        Generic_Set_Of A generic implementation of ASN.1 SET OF
         Implicit Implicitly encoded sets
      Strings Implementations of ASN.1 strings
        Explicit Explicitly encoded strings
          Constrained Explicitly encoded strings restricted to a single string type
        Implicit Implicitly encoded strings
           Constrained Implicitly encoded strings restricted to a single string type
      Tagged_Values An implementation of ASN.1 tags
      Text_IO Text output of ASN.1 data object
      Unsigneds_8 An implementation of ASN.1 INTEGER for Unsigned_8
      Unsigneds_16 An instantiation of Generic_Unsigned with Unsigned_16
      Unsigneds_32 An instantiation of Generic_Unsigned with Unsigned_32
      Unsigneds_64 An instantiation of Generic_Unsigned with Unsigned_64
      X509_Certificates An implementation of X.509 certificates
         Stream_IO Stream I/O of X.509 certificates
    Big_Endian Big-endian encoded data items, parent package
      Generic_Double_Precision_IEEE_754 Double-precision IEEE 754 numbers (generic)
      Generic_Single_Precision_IEEE_754 Single-precision IEEE 754 numbers (generic)
      IEEE_754_Floats Instantiation of Generic_Single_Precision_IEEE_754 with Float
      IEEE_754_Long_Floats Instantiation of Generic_Double_Precision_IEEE_754 with Long_Float
      Integers Signed integers
      Unsigneds Unsigned modular integers
    Chain_Code Chain-coded data items, parent package
      Generic_Integer Signed integers (generic)
      Generic_Unsigneds Unsigned integers (generic)
      Integers Instantiation of Generic_Integer with Integer
      Naturals Instantiation of Generic_Unsigneds with Natural
    ELV_MAX_Cube_Client An implementation of ELV/e-Q3 MAX! cube client
      Stream_IO Stream I/O operations for ELV/e-Q3 MAX! cube data
      Time_Zones Time zones constants to use with ELV/e-Q3 MAX! cube
      Topology Handling cube's topology descriptions
    Expected_Sequence Expected sequence of fixed content
    HTTP_Server An implementation of HTTP server
      SQLite_Browser HTTP server for browsing SQLite3 databases
      WebSocket_Server HTTP server for running connection objects over WebSockets
    HTTP_Client An implementation of HTTP client
      Signaled A HTTP client to use with an external task
    LDAP The base package of LDAP protocol implementation
      Client LDAP client implementation
      Server LDAP server implementation
    Little_Endian Little-endian encoded data items, parent package
      Generic_Double_Precision_IEEE_754 Double-precision IEEE 754 numbers (generic)
      Generic_Single_Precision_IEEE_754 Single-precision IEEE 754 numbers (generic)
      IEEE_754_Floats Instantiation of Generic_Single_Precision_IEEE_754 with Float
      IEEE_754_Long_Floats Instantiation of Generic_Double_Precision_IEEE_754 with Long_Float
      Integers Signed integers
      Unsigneds Unsigned modular integers
    MODBUS_Client An implementation of MODBUS client
      Synchronous A synchronous MODBUS client to use with an external task
    Terminated_Strings Strings terminated by a special character
      Variable_Length_Arrays Variable-length arrays
      Variable_Length_Strings Variable-length strings
  MQTT Basic implementation of a MQTT peer
    Server A full implementation of a MQTT server (broker)
    Streams Stream interface to MQTT messages
  NTP Simple NTP time query implementation
  Server Multiple TCP connections server, a low-level implementation
    Blocking Server to handle connections over blocking I/O channels
    Handles Instantiation of Object.Handle with Connection type
    OpenSSL Secure TLS connection server based on OpenSSL
        Pooled Server with a pool of worker tasks
    Secure Secure TLS connection server based on GNUTLS
      Anonymous An implementation of connection factory for anonymous authentication
      X509 An implementation of connection factory for X509 authentication
  SMTP Base package of SMTP
    Client An implementation of SMTP client
      Synchronous Synchronous mail sending
GNU.DB.CLI.API Thick bindings to GNADE ODBC
  Keys Persistent objects identification in GNADE ODBC
    Edit String conversions for GNADE ODBC objects keys
    Sets Sets of persistent objects keys for GNADE ODBC
  Links Management of persistent objects dependencies in GNADE ODBC
GNUTLS GNUTLS bindings
IEEE_754 The parent package for dealing with IEEE 754 representations
  Decimal32 IEEE 754 32-bit decimal format
  Decimal64 IEEE 754 64-bit decimal format
  Decimal128 IEEE 754 128-bit decimal format
  Edit String editing facilities for 128-bit integers
  Floats An instance of IEEE_754.Generic_Double_Precision with Float
  Generic_Double_Precision 64-bit double precision IEEE 754 floating-point representations
  Generic_Single_Precision 32-bit single precision IEEE 754 floating-point representations
  Long_Floats An instance of IEEE_754.Generic_Double_Precision with Long_Float
Julia Interfacing the Julia language
  Generic_1D_Array Interfacing 1D arrays
  Generic_2D_Array Interfacing 2D arrays
  Generic_3D_Array Interfacing 3D arrays
  Load_Julia_Library Loading Julia's library
Long_Float_Chebyshev_Polynomials An instance of Generic_Chebyshev_Polynomials with Long_Float
Long_Float_Cubic_Spline An instance of Generic_Cubic_Spline with Long_Float
Long_Float_Waveform An instance of Persistent.Memory_Pools.Streams.Generic_Float_Waveform with Long_Float
Object The type Entity
  Archived The types Deposit, Backward_Link and Deposit_Container for handling persistency
    Handle The type Handle (to persistent objects) and operations on it. The package is generic
    Iterators The type References_Iterator, an iterator of object's references
    Lists The type Deposit_List, a list of persistent objects
    Sets The type Deposit_Set, a set of persistent objects
  Handle The type Handle and operations on it
    Generic_Bounded_Array The type Bounded_Array, a generic bounded array of objects
    Generic_Handle_Set The type Set, a generic set of objects
    Generic_Set The type Set, a generic set of objects
    Generic_Unbounded_Array The type Unbounded_Array, a generic unbounded array of objects
ODBC The parent package of ODBC bindings
  Architecture_Dependent ODBC declarations dependent on the machine architecture, e.g. x86_64, i686
  API Persistent objects identification in ODBC
    Keys Persistent objects identification in ODBC
         Edit String conversions for ODBC objects keys
      Sets Sets of persistent objects keys for ODBC
    Links Management of persistent objects dependencies in ODBC
  Bound_Parameters Data types used for bound parameters of prepared statements
  Driver_Dependent ODBC declarations dependent on the ODBC driver manager, e.g. ODBC32, unixODBC
  Thin Thin ODBC bindings
  SQLTypes ODBC data types
OpenSSL OpenSSL bindings
Parsers The base package of syntax analyzers
  Ada The type Ada_Expression, an implementation of Ada 95 expression parser
  Generic_Argument The type Stack, the abstract base for argument stacks (generic)
    Segmented_Stack An implementation of argument stacks based on segmented stacks
  Generic_Lexer The type Lexer, the abstract base for expression analyzers (generic)
    Ada_Blanks An analyzer supporting Ada 95 comments and blanks
    Ada_2005_Blanks An analyzer supporting Ada 2005 comments and blanks
    Blanks An analyzer supporting blanks of spaces and formatting characters HT, LF, CR, VT, FF
    Cpp_Blanks An analyzer supporting C++ comments and blanks
  Generic_Operation The expression operations and their descriptors (generic)
    Generic_Stack The type Stack, the abstract base of operation stacks
    Segmented_Stack An implementation of operation stacks based on segmented stacks
  Generic_Source An abstract interface of code source (generic)
    Get_Ada_Blank Matching an Ada 95 comment (generic procedure)
    Get_Ada_2005_Blank Matching an Ada 2005 comment (generic procedure)
    Get_Blank Matching blank characters (generic procedure)
    Get_Cpp_Blank Matching an C++ comment (generic procedure)
    Get_Text Matching a text in the Latin-1 code source (generic procedure)
    Get_Token Matching a table against the code source (generic procedure)
    Get_UTF8_Text Matching a text in the UTF-8 code source (generic procedure)
    Keywords Keyword-matching generated from an enumeration type (generic) 
    Text_IO Debugging output for source code cursors
    XPM Matching XPM image format (generic package)
  Generic_Token The table tokens for table-driven analyzers (generic)
    Generic_Token_Lexer The type Lexer, the abstract base for table-driven analyzers
    Segmented_Lexer An implementation of table-driven analyzers based on segmented argument and operation stacks
  JSON The root package of JSON RFC 7159 implementation
    Generic_Parser A generic implementation of JSON parser
    Multiline_Source An instance of Parsers.JSON.Generic_Parser with Parsers.Multiline_Source
    String_Source An instance of Parsers.JSON.Generic_Parser with Parsers.String_Source
  Multiline_Source The type Source, the abstract base for sources having multiple lines of code
    Latin1_Text_IO The type Source, a code source based on Ada.Text_IO (with Latin-1 to UTF-8 recoding)
    Location_Text_IO Debugging output for source code cursors, an instance of Parsers.Generic_Source.Text_IO
    Standard_Input The type Source, a code source based on Ada.Text_IO
    Stream_IO The type Source, a code source based on Ada streams
    Text_IO The type Source, a code source based on Ada.Text_IO
    Wide_Text_IO The type Source, a code source based on Ada.Wide_Text_IO (with recording into UTF-8)
    XPM An instance of Parsers.Generic_Source.XPM based on Multiline_Source
  String_Source The type Source, a single string code source
Persistent Abstract persistent storage interface
  APQ APQ implementation of persistent storage
  Blocking_Files Blocking files access
    Text_IO Text output of byte index and byte offset
    Transactional Blocking files with transactions
      Dump Textual output of internal structures of a transactional blocking file
  Directory Persistent directory objects
  Data_Bank Abstract persistent storage with objects identified by keys
    Index Index for an abstract persistent storage
      Text_IO Text output of the persistent storage index
    Indexed Abstract indexed persistent storage
      Text_IO Text output of the persistent storage index
    Mutexes Interlocking of Indexed_Storage_Object operations
    Reference Persistent storage references for proxy objects
  Handle Handles to persistent storage objects
    Factory Persistent storage factory
  Memory_Pools Persistent memory pool backed by a direct access file
    Streams Stream interface to persistent memory pool
      External_B_Tree Persistent storage raw B-tree
         Generic_Table Persistent storage multi-keyed table
      Generic_External_B_Tree Persistent storage B-tree
      Generic_External_Ptr_B_Tree Persistent storage pointer-valued B-tree
      Generic_Float_Waveform Persistent storage waveform of (x,y) pairs
      IEEE_754 Conversions to store IEEE 754 floats in persistent storage
  Native_ODBC ODBC implementation of persistent storage
    Text_IO Text output of the ODBC persistent storage index
  ODBC GNADE ODBC implementation of persistent storage
    Text_IO Text output of the GNADE ODBC persistent storage index
  Single_File Single file implementation of persistent storage
    Text_IO Text output of the persistent storage index and underlying file structures
  Streams Persistent streams
    Dump Text output of the internal structures of the persistent stream
  SQLite SQLite implementation of persistent storage
    Text_IO Text output of the SQLite persistent storage index
Py Python bindings
Pipe_Streams Pipe streams
SQLite Native bindings to SQLite
Stack_Storage The stack pools implemented by the type Pool
  Mark_And_Release Mark and release storage pools of limited controlled objects
Storage_Streams Memory-allocated streams
Strings_Edit The packages dealing with strings editing as described in a separate document
  Symmetric_Serialization Symmetric encoding and decoding strings.
Synchronization The parent package of the locking synchronization primitives
  Events Plain events which can be signaled, reset and awaited for
  Generic_Events_Array Arrays of events which can be signaled, reset and awaited in any combination of in race condition free way
  Generic_Mutexes_Array Arrays of reentrant mutexes, deadlock-free with an enforced order of locking
  Generic_Pulse_Events Race condition free event distributing pulsed value to multiple tasks
  Interprocess Inter-process communication root package
    Events Inter-process events
    Generic_Shared_Object Shared inter-process object
    Generic_FIFO FIFO inter-process queue
    Memory_Pools Inter-process memory pool
    Mutexes Inter-process re-entrant mutexes
    Process_Call_Service Inter-process remote procedure call service
      Generic_Call_Service_Arrays Arrays of remote procedure call services
      Generic_Dyadic_Function Remote functions with two arguments and result
      Generic_Dyadic_Procedure Remote procedures with two arguments
      Generic_Parameterless_Function Remote functions without argument
      Generic_Ternary_Function Remote functions with three arguments and result
      Generic_Ternary_Procedure Remote procedures with three arguments
      Generic_Unary_Function Remote functions with one argument and result
      Generic_Unary_Procedure Remote procedures with one argument
      Get_String An instantiation of Generic_Parameterless_Function with String type
      Manager A manager of remote call services array
      Parameterless_Procedure Remote procedures without arguments
      Process_String An instantiation of Generic_Unary_Function with two String types
      Set_String An instantiation of Generic_Unary_Procedure with String type
    Pulse_Events Inter-process pulse events
    Streams Inter-process streams
  Muexes Re-entrant mutexes
  Pulse_Events Race condition free pulse events
Universally_Unique_Identifiers Universally unique identifiers according to RFC 4122
  Edit UUID string editing
Tables The packages related to tables management as described in a separate document
  UTF8_Names Tables of UTF-8 encoded case-insensitive items

The packages related to tables management are described in Tables.

For the packages dealing with strings editing see Strings edit.

[Back][TOC][Next]

18.2. Tests and examples

18.2.1. Tests

The subdirectory test_components contains various tests and examples:

Compilation unit Executable Provides Requires
test_approximations yes Test for Chebyshev series and gamma function  
test_APQ_persistence yes APQ persistent storage test APQ
test_APQ_session no A package used to open an APQ session. Queries for connection parameters using text I/O APQ
test_association yes Test for infix operation associations. Uses the file test_association.txt as the source to parse.  
test_association_expression no Used by test_association  
test_b_trees yes Test for B-trees  
test_blackboard yes Test for blackboards  
test_blackboard_performance yes Test for blackboards performance  
test_block_streams yes Test for block streams  
test_blocking_files yes Test for blocking files access  
test_bounded_maps no Test instantiation of bounded maps, used in test_generic_maps  
test_call_service_instance yes Test for inter-process call services  
test_call_services no Test implementation of call services, used in test_call_service_instance  
test_cubic_spline yes Test for cubic spline interpolation  
test_data_client yes Test client for multiple connections test server  
test_data_server yes Multiple connections test server, ASN.1 tests  
test_data_servers no Implementation of the multiple connections test server  
test_dining_philosophers yes A solution of the dining philosophers problem  
test_dining_philosophers_forks no Used in test_dining_philosophers  
test_echo_client yes Echo client test  
test_echo_client_async yes Echo client test using multiple connections server  
test_echo_server yes Echo server test  
test_echo_servers no Implementation of the echo server  
test_elv_max_cube_client yes Test for ELV/e-Q3 MAX! cube client  
test_elv_max_cube_clients no Test ELV/e-Q3 MAX! cube client used in test_elv_max_cube_client  
test_fifo yes Test for FIFO  
test_generic_sets yes Test for Generic_Set  
test_generic_indefinite_sets yes Test for Generic_Indefinite_Set  
test_graphs yes Test for Generic_Directed_Graph  
test_handles yes Test for handles to objects  
test_hello_rpc_client yes RPC hello client example  
test_hello_rpc_client_data no RPC hello client implementation, used in test_hello_rpc_client  
test_hello_rpc_server yes RPC hello server example  
test_hello_rpc_server_data no RPC hello server implementation, used in test_hello_rpc_server  
test_http_client yes Test for HTTP client  
test_http_continouos_server yes Test for HTTP server that keeps on sending an "infinite" page  
test_http_continouos_servers no Implementation of a custom HTTP server sending an "infinite" page  
test_http_mqtt_servers no Implementation of a custom HTTP server accepting MQTT connections over WebSockets  
test_http_sqlite_browser yes SQLite database browser test  
test_http_sqlite_server no Implementation of a server to browse SQLite databases  
test_http_server yes Test for HTTP server  
test_http_servers no Implementation of a custom HTTP server  
test_http_servers-secure no Implementation of a custom secure HTTP server factory using GNUTLS  
test_http_servers-openssl no Implementation of a custom secure HTTP server factory using OpenSSL  
test_https_client yes Test for HTTPS client based in GNUTLS  
test_https_openssl_client yes Test for HTTPS client based in OpenSSL  
test_https_openssl_json_client yes Test for HTTPS client based in OpenSSL combined with parsing JSON content  
test_https_openssl_server yes Test for HTTPS server based in OpenSSL  
test_https_server yes Test for HTTPS server based in GNUTLS  
test_ieee_754 yes Test for IEEE 754 packages  
test_json yes Test for JSON parser  
test_julia yes Test for Julia language interfacing  
test_integer_b_trees no Used in test_b_trees  
test_integer_fifo no Used in test_fifo  
test_integer_signaled_fifo no Used in test_fifo  
test_integer_sets no Used in test_generic_sets  
test_interprocess_synchronization yes Test for inter-process synchronization  
test_ldap_client yes Test for LDAP client  
test_linked_lists yes Test for doubly-linked webs and lists  
test_linked_lists.controlled_elements no Test for doubly-linked webs and lists, a separate body for class-wide controlled items  
test_linked_lists.string_elements no Test for doubly-linked webs and lists, a separate body for string items  
test_linked_lists.task_elements no Test for doubly-linked webs and lists, a separate body for task items  
test_linked_lists_of_elements no Test package for doubly-linked webs and lists. Instantiations for the base type of for class-wide controlled items  
test_linked_lists_of_elements.strings no Test package for doubly-linked webs and lists. Controlled items containing strings  
test_linked_lists_of_strings no Test package for doubly-linked webs and lists. Instantiations for string items  
test_linked_lists_of_tasks no Test package for doubly-linked webs and lists. Instantiations for task items  
test_linked_lists_scheduler no Test package for doubly-linked list based scheduler example.  
test_linked_lists_scheduler_test yes Test program for doubly-linked list based scheduler example.  
test_modbus_client yes Test for MODBUS client  
test_mqtt_client yes Test for MQTT client  
test_mqtt_clients no Test package for MQTT client, used in test_mqtt_client and test_mqtt_serial  
test_mqtt_serial yes Test for MQTT connection over a serial link  
test_mqtt_serials no Test package for serial MQTT communication, used in test_mqtt_serial  
test_mqtt_server yes Test for MQTT server  
test_mqtt_servers no Test package for MQTT server, used in test_mqtt_server and test_mqtt_serial  
test_mqtt_webserver yes Test for MQTT WebSockets server  
test_my_string no An implementation of varying strings using objects, illustrative example. Used in test_handles.  
test_my_string.handle no An implementation of handles to string objects, example. Used in test_handles.  
test_native_odbc_persistence yes ODBC persistent storage test  
test_native_odbc_session no A package used to open an ODBC session. Queries for connection parameters using text I/O GNADE
test_ntp yes NTP time query test  
test_object no A test object used in test_handles.  
test_object.handle no Handles to test objects. Used in test_handles.  
test_object.handle_array no Arrays of test objects. Used in test_handles.  
test_odbc_bindings yes An extensive test for ODBC bindings provided by the library  
test_odbc_persistence yes GNADE ODBC persistent storage test, example. GNADE
test_odbc_session no A package used to open a GNADE ODBC session. Queries for connection parameters using text I/O GNADE
test_parser_stream_io yes A test for stream based sources  
test_persistent_file_storage no An implementation of persistent storage using direct I/O.  
test_persistent_memory_pool yes Persistent memory pool test.  
test_persistent_streams yes Persistent streams test  
test_persistent_storage yes Persistent storage test, example.  
test_persistent_tree no An implementation of tree nodes as persistent objects, example  
test_pipe_stream yes Pipe streams.  
test_python yes Python bindings test  
test_record_blackboards no Used in test_blackboard  
test_sequencer yes Test for symmetric serialization  
test_sequencer_sets no Used in test_sequencer  
test_set no A set of string objects declared in test_my_string.handle. Used in test_handles.  
test_single_file_persistence yes Single file persistent storage test  
test_smtp_client yes SMTP client test  
test_sqlite_benchmark yes SQLite vs. persistent B-tree benchmark test  
test_sqlite_persistence yes SQLite persistent storage test, example.  
test_stack yes Test for mark and release stacks  
test_stack_item no Used in test_stack  
test_safe_string_blackboards no Used in test_blackboard  
test_storage_streams yes Test for storage streams  
test_string_blackboards no Used in test_blackboard  
test_string_fifo no Used in test_fifo  
test_string_graph no Used in test_graphs  
test_string_signaled_fifo no Used in test_fifo  
test_suffix_tree ni Used in test_graphs and as an example.  
test_synchronization_events yes Test for synchronization primitives  
test_synchronization_events_array no Used in test_synchronization_events  
test_synchronization_pulse_events no Used in test_synchronization_events  
test_transactional_blocking_files yes Test for transactional blocking files  
test_utf8_tables yes Test for tables of UTF-8 tokens  
test_utf8_tables_table no Used in test_utf8_tables  
test_websocket_duplex_server yes Test for full-duplex WebSockets  
test_websocket_duplex_servers no Used in test_websocket_duplex_server  
test_websocket_server yes Test for half-duplex WebSockets  
test_websocket_servers no Used in test_websocket_server  

18.2.2. Building tests with GNAT

Tests that do not require nether GNADE nor APQ can be built using gnatmake:

gnatmake -I.. <file-name>

Note that <file-name> should refer an *.adb file. For example:

gnatmake -I.. test_handles.adb

Alternatively the file components-tests.gpr is the GNAT GPS project files which can be used instead.

18.2.3. Building tests that use GNADE

The tests depending on GNADE will require an installation of GNADE. On a Linux box they can be built using gnatmake as follows:

gnatmake -I.. -I/usr/local/gnade/include test_odbc_persistence.adb

Under Windows it might be (one command line):

gnatmake -I.. -Ic:/gnade/win32-include test_odbc_persistence.adb -largs -Lc:/gnade/win32-lib -lgnadeodbc -LC:/gnade/lib/win32 -lodbc32

Refer to GNADE documentation for more information. GNADE is under development, so paths might change.

The file components-gnade-odbc_persistence_tests.gpr is the GNAT GPS project files to build the test under GPS.

18.2.4. Building tests that use APQ

The tests that use APQ should require no additional parameters. At least under Windows APQ is fully integrated with GNAT compiler. If you use a source distribution of APQ, it would probably be required to specify additional directory paths.

18.2.5. Parser examples

The subdirectory parser-examples contains examples of using parsers. It has the following subdirectories:

The following command in the corresponding subdirectory can be used to build a parser example:

gnatmake -I../.. <file-name>

The subdirectory xpm contains Parsers.Generic_Source.XPM and Parsers.Multiline_Source.XPM.

18.2.6. Building tests that use SQLite

The test that uses SQLite is built using gnatmake as follows:

gcc -c ../sqlite-sources/sqlite3.c
gnatmake -c -I.. test_sqlite_persistence.adb
gnatbind -I.. test_sqlite_persistence.ali
gnatlink test_sqlite_persistence.ali sqlite3.o

The file components-sqlite-sqlite_persistence_tests.gpr is the GNAT GPS project files to build the test under GPS.

18.2.7. Building tests that use native ODBC bindings

The ODBC bindings test under Windows is built as:

gnatmake -I.. -I../odbc -I../odbc/odbc32 -I../odbc/odbc32/i686 test_odbc_bindings.adb -largs -lodbc32

Under Linux:

gnatmake -I.. -I../odbc -I../odbc/unixodbc -I../odbc/unixodbc/i686 test_odbc_bindings.adb -largs -lodbc

Depending on the architecture either i686 or x86_64 subdirectory must be specified. The project file components-odbc-odbc_bindings_tests.gpr can be used with the GNAT. Note that the scenario variables arch and odbc must be correctly set.

Similarly is built test_native_odbc_persistence.adb. The corresponding project file is components-odbc-odbc_persistence_tests.gpr.


[Back][TOC][Next]

19. Installation

The software does not require special installation. The archive's content can be put in a directory and used as-is. For users of GNAT compiler the software provides gpr project files, which can be used in the Gnat Programming Studio (GPS).

For CentOS, Debian, Fedora, Ubuntu Linux distributions there are pre-compiled packages, see the links on the top of the page.

Persistence packages based on the GNADE project and the APQ require the corresponding software installed. When the Simple Components for Ada are installed using GPS Library Installer without GNADE, APQ, SQLite etc, then the installation of the corresponding parts of the Simple Components will fail. These faults can be safely ignored during the installation.

Project files *.gpr Simple Components, Strings Edit, Tables
  Multiple TCP/IP connections server
    HTTP server and client
      ELV/e-Q3 MAX! cube client
        MODBUS client
          Secure SSL/TSL connections servers, GNUTLS based
            Secure SSL/TSL connections servers, OpenSSL based
              SQLite3
                ODBC 32/64
                  SQLite3 HTTP browser
                    GNUTLS
                      OpenSSL
                        LDAP
                          MQTT
                            NTP
                              SMTP
                                Julia language interface
                                  Python language interface
                                    GNADE (depreciated)
                                      JSON parser
                                        APQ (depreciated)        Usage in a custom project
components + - - - - - - - - - - - - -  - - - - - - - with "components.gpr";
components-apq + - - - - - - - - - - - - - - - - - - - + with "components-apq.gpr";
components-connections_server + + - - - - - - - - - - - - - - - - - - - with "components-connections_server.gpr";
components-connections_server-http_server + + + - - - - - - - - - - - - - - - - - - with "components-connections_server-http_server.gpr";
components-connections_server-http_server-sqlite_browser + + + - - - - + - + - - - - - - - - - - - with "components-connections_server-http_server-sqlite_browser.gpr";
components-connections_server-ldap + + - - - - - - - - - - + - - - - - - - - with "components-connections_server-ldap.gpr";
components-connections_server-elv_max_cube_client + + - + - - - - - - - - - - - - - - - - - with "components-connections_server-elv_max_cube_client.gpr";
components-connections_server-modbus_client + + - - + - - - - - - - - - - - - - - - - with "components-connections_server-modbus_client.gpr";
components-connections_server-mqtt + + - - - - - - - - - - - + - - - - - - - with "components-connections_server-mqtt.gpr";
components-connections_server-openssl + + - - - - + - - - - + - - - - - - - - - with "components-connections_server-openssl.gpr";
components-connections_server-secure + + - - - + - - - - + - - - - - - - - - - with "components-connections_server-secure.gpr";
components-connections_server-smtp + + - - - - - - - - - - - - - + - - - - - with "components-connections_server-smtp.gpr"
components-json + - - - - - - - - - - - - - - - - - - + - with "components-json.gpr"
components-julia + - - - - - - - - - - - - - - - + - - - - with "components-julia.gpr"
components-gnade + - - - - - - - - - - - - - - - - - + - - with "components-gnade.gpr";
components-gnutls + - - - - - - - - - + - - - - - - - - - - with "components-gnutls.gpr";
components-ntp + - - - - - - - - - - - - - + - - - - - - with "components-ntp.gpr";
components-odbc + - - - - - - - + - - - - - - - - - - - - with "components-odbc.gpr";
components-openssl + - - - - - - - - - - + - - - - - - - - - with "components-openssl.gpr";
components-python + - - - - - - - - - - - - - - - - + - - - with "components-python.gpr"
components-sqlite + - - - - - - + - - - - - - - - - - - - - with "components-sqlite.gpr";

GNAT project scenario variables.

arch specifies the architecture. It can be used in combination with Object_Dir when compiled for multiple architectures:

Atomic_Access controls the method to use:

Development controls debugging information and optimization level:

Legacy controls Ada language version:

Object_Dir controls the location of object files:

odbc controls the ODBC driver. It is relevant only if ODBC is used:

Target_OS controls choice of bindings to the low-level OS primitives:

Tasking controls reference-counted objects access from multiple tasks:

Traced_objects controls if tracing referenced objects is active:


[Back][TOC][Next]

20. Changes log

The following versions were tested with the compilers:

and the GtkAda versions:

Changes (29 June 2024) to the version 4.68:

Changes (30 September 2023) to the version 4.67:

Changes (14 June 2023) to the version 4.66:

Changes (26 November 2022) to the version 4.65:

Changes (26 November 2022) to the version 4.64:

Changes (19 August 2022) to the version 4.63:

Changes (5 August 2022) to the version 4.62:

Changes (22 May 2022) to the version 4.61:

Changes (16 April 2022) to the version 4.60:

Changes (29 January 2022) to the version 4.59:

Changes (6 November 2021) to the version 4.58:

Changes (10 July 2021) to the version 4.57:

Changes (12 June 2021) to the version 4.56:

Changes (2 May 2021) to the version 4.55:

Changes (14 February 2021) to the version 4.54:

Changes (13 January 2021) to the version 4.53:

Changes (13 December 2020) to the version 4.52:

Changes (18 October 2020) to the version 4.51:

Changes (1 September 2020) to the version 4.50:

Changes (31 May 2020) to the version 4.49:

The following versions were tested with the compilers:

and the GtkAda versions:

Changes (7 May 2020) to the version 4.48:

Changes (11 March 2020) to the version 4.47:

Changes (1 March 2020) to the version 4.46:

Changes (14 January 2020) to the version 4.45:

Changes (10 December 2019) to the version 4.44:

Changes (21 November 2019) to the version 4.43:

Changes (2 November 2019) to the version 4.42:

Changes (18 September 2019) to the version 4.41:

Changes (5 August 2019) to the version 4.40:

Changes (5 August 2019) to the version 4.40:

The following versions were tested with the compilers:

and the GtkAda versions:

Changes (13 May 2019) to the version 4.39:

Changes (21 Jan 2019) to the version 4.38:

Changes (11 Jan 2019) to the version 4.37:

Changes (8 Jan 2019) to the version 4.36:

Changes (22 Dec 2018) to the version 4.35:

Changes (11 Dec 2018) to the version 4.34:

Changes (2 Dec 2018) to the version 4.33:

Changes (25 Nov 2018) to the version 4.32:

Changes (18 Nov 2018) to the version 4.31:

Changes (7 Nov 2018) to the version 4.30:

Changes (5 Aug 2018) to the version 4.29:

Changes (1 June 2018) to the version 4.28:

Changes (2 May 2018) to the version 4.27:

Changes (28 January 2018) to the version 4.26:

Changes (26 January 2018) to the version 4.25:

Changes (25 November 2017) to the version 4.24:

Changes (1 October 2017) to the version 4.23:

Changes (4 September 2017) to the version 4.22:

Changes (24 July 2017) to the version 4.21:

The following versions were tested with the compilers:

and the GtkAda versions:

Changes (17 April 2017) to the version 4.20:

Changes (12 March 2017) to the version 4.19:

Changes (20 February 2017) to the version 4.18:

Changes (4 February 2017) to the version 4.17:

Changes (19 November 2016) to the version 4.16:

Changes (14 October 2016) to the version 4.15:

Changes (25 July 2016) to the version 4.14:

The following versions were tested with the compilers:

Changes (21 June 2016) to the version 4.13:

Changes (30 May 2016) to the version 4.12:

Changes (10 April 2016) to the version 4.11:

Changes (1 March 2016) to the version 4.10:

Changes (18 October 2015) to the version 4.9:

Changes (24 August 2015) to the version 4.8:

Changes (29 June 2015) to the version 4.7:

The following versions were tested with the compilers:

Changes (13 June 2015) to the version 4.6:

Changes (2 April 2015) to the version 4.5:

Changes (17 January 2015) to the version 4.4:

Changes (20 December 2014) to the version 4.3:

Changes (23 November 2014) to the version 4.2:

Changes (16 September 2014) to the version 4.1:

Changes (24 July 2014) to the version 4.0:

Changes (June 2014) to the version 3.22:

Changes (1 June 2014) to the version 3.22:

The following versions were tested with the compilers:

Changes (15 March 2013) to the version 3.21:

Changes (20 October 2012) to the version 3.20:

Changes (14 October 2012) to the version 3.19:

Changes (10 August 2012) to the version 3.18:

Changes to the version 3.17:

Changes to the version 3.16:

Changes to the version 3.15:

Changes to the version 3.14:

Changes to the version 3.13:

Changes to the version 3.12:

The following versions were tested with the compilers:

Changes to the version 3.11:

The following versions were tested with the compilers:

Changes to the version 3.10:

Changes to the version 3.9:

Changes to the version 3.8:

The following versions were tested with the compilers:

Changes to the version 3.7:

Changes to the version 3.6:

Changes to the version 3.5:

Changes to the version 3.4:

Changes to the version 3.3:

The following versions were tested with the compilers:

Changes to the version 3.2:

Changes to the version 3.1:

Changes to the version 3.0:

The following versions were tested with the compilers:

Changes to the version 2.9:

Changes to the version 2.8:

Changes to the version 2.7:

Changes to the version 2.5:

The following versions were tested with the compilers:

Changes to the version 2.4:

The following versions were tested with the compilers:

Changes to the version 2.3:

The following versions were tested with the compilers:

Changes to the version 2.2:

Changes to the version 2.1:

The following versions were tested with the GNAT 3.15p compiler:

Changes to the version 2.0:

Changes to the version 1.10:

Changes to the version 1.9:

Changes to the version 1.8:

Changes to the version 1.7:

Changes to the version 1.6:

Changes to the version 1.5:

Changes to the version 1.4:

Changes to the version 1.3:

Changes to the version 1.2:

Changes to the version 1.1:

Changes to the version 1.0:


[Back][TOC]

21. Table of Contents

1 Objects and handles (smart pointers)
    1.1. Objects
       1.1.1 Tasking
    1.2. Handles to objects
    1.3. An example of use
    1.4. Bounded arrays of objects
    1.5. Unbounded arrays of objects
    1.6. Sets of objects
    1.7. Universal sets of objects

2 Persistency
    2.1. Persistent objects
       2.1.1. Types
    2.2. Handles to persistent objects
    2.3. Persistent directories
    2.4. Persistent storage implementation example
       2.4.1. Persistent storage implementation
       2.4.2. Persistent objects implementation
       2.4.3. Test program
       2.4.4. Predefined persistent storage test
    2.5. Abstract persistent storage
    2.6. Handles to persistent storage
    2.7. Persistent storage factory
    2.8. Persistent storage implementations
       2.8.1. ODBC databases
       2.8.2. GNADE ODBC databases
       2.8.3. APQ-interfaced databases
       2.8.4. SQLite3 databases
       2.8.5. Single file implementation
    2.9. Implementation of a new persistent storage
       2.9.1. Databases
       2.9.2. Storages with keys
       2.9.3. Storage index
       2.9.4. Indexed storage
       2.9.5. Proxy objects
    2.10. Visual browsing of a persistent storage
    2.11. Blocking files
       2.11.1. Text I/O
    2.12. Transactional blocking files
       2.12.1. Textual output of internal structures
    2.13. Persistent streams
       2.13.1. Textual output of internal structures

3 Sets and maps
    3.1. Sets
       3.1.1. Sets of indefinite elements
       3.1.2. Sets of discrete elements
    3.2. Maps
       3.2.1. Maps of indefinite keys and objects
       3.2.2. Maps of discrete keys
       3.2.3. Maps of discrete keys to indefinite objects
       3.2.4. Bounded maps
       3.2.5. Bounded maps of indefinite keys and objects
    3.3. B-trees
       3.3.1. B-trees of definite keys and objects
       3.3.2. B-trees of indefinite keys and objects
       3.3.3. Persistent B-trees
       3.3.4. Persistent pointer-valued B-trees
       3.3.5. Persistent raw B-trees
       3.3.6. Persistent multi-keyed tables
       3.3.7. Persistent waveforms
4 Unbounded arrays

5 Unbounded arrays of pointers

6 Stacks
    6.1. Stacks based on abstract arrays
    6.2. Segmented stacks
7 Pools
    7.1. Stack pool
    7.2. Mark and release pool for controlled objects
    7.3. Persistent storage memory pool
       7.3.1. Concurrent access to the container file
    7.4. Streams to persistent storage memory pool
       7.4.1. Output stream
       7.4.2. Input streams
       7.4.3. Generic look ahead
       7.4.4. Tagging progress indicator

8 Doubly-linked networks
    8.1. Doubly-linked lists of networks (specialization)
    8.2. Doubly-linked lists
       8.2.1. Double-linked list example
9 Graphs
    9.1. Directed graphs
    9.2. Directed weighted graphs
       9.2.1. Suffix tree example
10 Lock-free structures
    10.1. FIFO
       10.1.1. Lock-free FIFO of definite elements
       10.1.2. Signaled FIFO of definite elements
       10.1.3. Lock-free FIFO of indefinite elements
       10.1.4. Signaled FIFO of indefinite elements
    10.2. Blackboard
       10.2.1. Single publisher blackboard
       10.2.2. Multiple publishers blackboard
11 Locking synchronization primitives
    11.1. Notes on programming with protected objects
    11.2. Events
       11.2.1. Simple event
       11.2.2. Pulse event
       11.2.3. Events pulsing a value
       11.2.4. Arrays of events
       11.2.5. Synchronization at a checkpoint, Sample
    11.3. Mutexes
       11.3.1. Reentrant mutex
       11.3.2. Arrays of mutexes
       11.3.3. Dining philosophers sample
12 Inter-process communication
    12.1. Inter-process synchronization objects
    12.2. Events
    12.3. Pulse events
    12.4. Mutexes
    12.5. Shared objects
    12.6. FIFO, first-in, first-out queue
    12.7. Inter-process streams
    12.8. Memory pools
    12.9. Blackboard
    12.10. Remote procedure call
    12.11. Convenience remote call packages
       12.11.1. Parameterless procedure
       12.11.2. Parameterless generic functions
       12.11.3. Unary generic procedures
       12.11.4. Unary generic functions
       12.11.5. Dyadic generic procedures
       12.11.6. Dyadic generic functions
       12.11.7. Ternary generic procedures
       12.11.8. Ternary generic functions
    12.12. Arrays of call service objects
    12.13. Call service manager
    12.14. Remote procedure call example
13 Parsers
    13.1. Example first, a small calculator
    13.2. Basic considerations
       13.2.1. Types of lexical tokens
       13.2.2. Priorities and association
       13.2.3. Association checks
       13.2.4. Commutative operatiors
    13.3. The base package
    13.4. Sources
       13.4.1. Source cursors I/O
       13.4.2. Procedures to skip blanks
       13.4.3. Procedure to skip text
       13.4.4. Matching keywords
       13.4.5. Parsing XPM files
       13.4.6. String sources
       13.4.7. Multi-line sources
       13.4.8. Text file sources
       13.4.9. Standard input sources
       13.4.10. Latin-1 and wide text file sources
       13.4.11. Stream sources
    13.5. Tokens
       13.5.1. Table-driven lexers
       13.5.2. Table-driven segmented lexers
    13.6. Lexers
       13.6.1. Blank skipping
    13.7. Operations
       13.7.1. Operation stack
       13.7.2. Segmented operation stack
       13.7.3. Example of direct usage of the operation stack
    13.8. Arguments
       13.8.1. Argument stack
       13.8.2. Segmented argument stack
    13.9. Parsing tree example. Ada 95 expression parser
    13.10. JSON
       13.10.1. JSON parser
14 Cryptography
    14.1. Sequences of non-repeating pseudo random numbers
    14.2. Symmetric serialization
    14.3. ChaCha20 ciphers
15 Numerics
    15.1. IEEE 754 representations
       15.1.1. Single precision 32-bit floating-point numbers
       15.1.2. Double precision 64-bit floating-point numbers
       15.1.3. Decimal32 numbers
       15.1.4. Decimal64 nembers
       15.1.5. Decimal128 numbers
       15.1.6. 128-bit integers editing
    15.2. Chebyshev series
    15.3. Gamma function
    15.4. Normal cubic spline interpolation
16 Miscellany
    16.1. Address order
    16.2. SQLite bindings
       16.2.1. Backup interface
       16.2.2. Tracing interface
    16.3. Block streams
       16.3.1. Input block stream
       16.3.2. Output block stream
    16.4. Storage streams
    16.5. String streams
    16.6. Pipe streams
    16.7. ChaCha20 ciphering streams
    16.8. ODBC bindings
       16.8.1. Thin bindings
       16.8.2. Thick bindings
       16.8.3. ODBC environments
       16.8.4. ODBC connections
       16.8.5. Transactions
       16.8.6. ODBC commands
       16.8.7. Binding parameters
    16.9. GNUTLS bindings
    16.10. Interfacing Julia language
       16.10.1. Initialization and finalization
       16.10.2. Data types
       16.10.3. Correspondence between data types
       16.10.4. Julia tuples
       16.10.5. Julia arrays
       16.10.6. Execution of Julia code
       16.10.7. Calling Ada from Julia
       16.10.8. Handling Julia exceptions
       16.10.9. 1-d arrays
       16.10.10. 2-d arrays
       16.10.10. 3-d arrays
       16.10.12. Garbage collection control
    16.11. OpenSSL bindings
    16.12. Universally unique identifiers
       16.12.1. String editing
    16.13. Interfacing Python language
       16.13.1. Initialization and finalization
       16.13.2. Tasking
       16.10.3. Handles to objects
       16.10.4. Exceptions
       16.10.5. Executing Python from Ada
       16.10.6. Encapsulation of Ada objects
       16.10.7. Creating a Python class
       16.10.8. Parsing Python arguments
       16.10.9. Creating a Python module
17 Networking
    17.1. Multiple TCP connections server
       17.1.1. Multiple connection servers
       17.1.2. Connection objects
       17.1.3. Secure GNUTLS servers
       17.1.4. Secure OpenSSL servers
       17.1.5. Simple echo server sample
       17.1.6. Blocking I/O servers
    17.2. Connection state machine
       17.2.1. State machine connection object
       17.2.2. State machine data items
       17.2.3. Block of data items
       17.2.4. Null data item
       17.2.5. Data items selector
       17.2.6. External string buffer and arena pool
    17.3. Data items encoded big-endian
       17.3.1. IEEE 754 double precision float numbers
       17.3.2. IEEE 754 single precision float numbers
       17.3.3. Signed integers
       17.3.4. Unsigned integers
    17.4. Data items encoded little-endian
       17.4.1. IEEE 754 double precision float numbers
       17.4.2. IEEE 754 single precision float numbers
       17.4.3. Signed integers
       17.4.4. Unsigned integers
    17.5. Data items encoded using chain code
       17.5.1. Signed integers
       17.5.2. Unsigned integers
    17.6. Strings encoded using a terminator character
    17.7. Variable-length strings
    17.8. Variable-length arrays
    17.9. Expected sequence
    17.10. Server with a pool of worker tasks
    17.11. HTTP server protocol implementation
       17.11.1. Common operations
       17.11.2. Method callbacks
       17.11.3. Request header fields
       17.11.4. Receiving request bodies
       17.11.5. Sending short responses
       17.11.6. Sending response header fields
       17.11.7. Sending response bodies
       17.11.8. WebSockets
       17.11.9. Utility routines
       17.11.10. SQLite3 database browser
       17.11.11. WebSocket connection handler
    17.12. HTTP client protocol implementation
       17.12.1. Signaled client
    17.13. MODBUS client protocol implementation
       17.13.1. Synchronous client
    17.14. ELV/e-Q3 MAX! Cube protocol implementation
       17.14.1. Stream I/O
    17.15. MQTT protocol implementation
       17.15.1. MQTT peer
       17.15.2. MQTT message stream I/O
       17.15.3. MQTT server (broker)
    17.16. SMTP
       17.16.1. Mail address lists
       17.16.2. Mail objects
       17.16.3. SMTP client implementation
       17.16.4. SMTP synchronous client implementation
    17.17. NTP
    17.18. ASN.1
       17.18.1. Bit string
       17.18.2. Boolean
       17.18.3. Choice
       17.18.4. Date
       17.18.5. Distinguished name
       17.18.6. Enumerated
       17.18.7. Integer
       17.18.8. Length
       17.18.9. Null
       17.18.10. Object identifier
       17.18.11. Real
       17.18.12. Sequence
       17.18.13. Sequence of
       17.18.14. Set
       17.18.15. Set of
       17.18.16. String
       17.18.17. Tagged value
       17.18.18. Any object (parser)
       17.18.19. X.509 certificates
    17.19. LDAP
       17.19.1. LDAP peer
       17.19.2. LDAP middle-level interface
       17.19.3. Values list
       17.19.4. Attributes and lists of
       17.19.5. Update list
       17.19.6. Search filters
       17.19.7. Low-level interface
       17.19.8. LDAP server
       17.19.9. LDAP client
18 Packages
    18.1. Source packages
    18.2. Tests and examples
    Tables (a separate document)
    Strings edit (a separate document)
19 Installation
20 Changes log
21 Table of contents