Ada Programming/Libraries/Interfaces.C

Computing » Computer Science » Computer Programming » Ada Programming

This language feature is available from Ada 95 on.

Interfaces.C is a unit of the Predefined Language Environment since Ada 95.

Let's see the use of this package and its children through two examples, one for C and another for C++.

Example for C

PCRE is a popular C-library that implements regular expression pattern matching using the same syntax and semantics as Perl 5. PCRE means Perl Compatible Regular Expressions. The site of this library is pcre.org

Within Gnat, there are Ada library for regular expressions : Unix-style : GNAT.Regexp, GNAT.Regpat and Spitbol-like : GNAT.Spitbol.

As an alternative, interfacing with PCRE will show some techniques for dealing with a C library. There are enough primitives inside the package Interfaces.C.Strings to avoid a wrapper in C.

Abstract of header file pcre.h

Using version 8.02 of the file. The header file is quite long, we will just use 2 types and 4 operations, so what we need is just

/* Types */

struct real_pcre;                 /* declaration; the definition is private  */
typedef struct real_pcre pcre;

#ifndef PCRE_SPTR
#define PCRE_SPTR const char *
#endif

/* The structure for passing additional data to pcre_exec().  */

typedef struct pcre_extra {

/* record components we will not access */
} pcre_extra;

/* Indirection for store get and free functions */
PCRE_EXP_DECL void  (*pcre_free)(void *);

/* Exported PCRE functions */

PCRE_EXP_DECL pcre *pcre_compile(const char *, int, const char ''', int *,
                  const unsigned char *);
PCRE_EXP_DECL int  pcre_exec(const pcre *, const pcre_extra *, PCRE_SPTR,
                   int, int, int, int *, int);
PCRE_EXP_DECL pcre_extra *pcre_study(const pcre *, int, const char ''');

Interface of the thin binding

The objective of the interface is to hide the dependency from the package Interfaces.C. and the types exposed by the interface are : Integer, String, Pcre_Type, Extra_type, (and also System.Address in the complete binding).

The types Pcre and Extra are opaque pointers and should not be accessible outside the interface so they are made private. No operation on the components of pcre_extra are necessary, so pcre and pcre_extra are just declared as System.Address.

The complete cycle in PCRE is (compile/study/exec) where Gnat.Regex has 2 phases (compile/match); the study phase is an optimization of the pattern, that output an object of type Extra. Here we by-pass the study phase.

Compile allocates and returns a pointer to the compiled pattern, that is null if some error occured. In that case, an error message is available as well as the position of the error.

Free is used to deallocate the compiled pattern.

Match takes as inputs the compiled pattern, the subject Ada string to parse. The parameter length of string is necessary in case of partial scan.

procedure Match ouputs a return code (Result) that is negative if there is no match or an error. For a zero or positive return code, the match_array has the same output as the C library.

pcre.ads

-----------------------------------------------------------------------
--  interface to PCRE
-----------------------------------------------------------------------
with System;
with Interfaces;

package Pcre is

   type Options is new Interfaces.Unsigned_32;

   PCRE_CASELESS          : constant Options := 16#00000001#;  --Compile

   type Pcre_Type is private;
   type Extra_type is private;

   Null_Pcre  : constant Pcre_Type;
   Null_Extra : constant Extra_type;

   type Table_Type is private;
   Null_Table : constant Table_Type;


   -- output strings for error message; normally size of 80 should be enough
   subtype Message is String (1 .. 80);

   procedure Compile
     (Matcher      : out Pcre_Type;
      Pattern      : in String;
      Option       : in Options;
      Error_Msg    : out Message;
      Last_Msg     : out Natural;
      Error_Offset : out Integer;
      Table        : in Table_Type := Null_Table);

   procedure Free (M : Pcre_Type);

   -----------------
   -- Match_Array --
   -----------------
   -- Result of matches : same output as PCRE
   -- size must be a multiple of 3 x (nbr of parentheses + 1)
   -- For top-level, range should be 0 .. 2
   -- For N parentheses, range should be 0 .. 3*(N+1) -1
   -- If the dimension of Match_Array is insufficient, Result of Match is 0.
   --
   type Match_Array is array (Natural range <>) of Natural;

   procedure Match
     (Result              : out Integer;
      Match_Vec           : out Match_Array;
      Matcher             : in Pcre_Type;
      Extra               : in Extra_type;
      Subject             : in String;
      Length, Startoffset : in Integer;
      Option              : in Options := 0);

private

   type Pcre_Type is new System.Address;
   type Extra_type is new System.Address;

   Null_Pcre  : constant Pcre_Type  := Pcre_Type (System.Null_Address);
   Null_Extra : constant Extra_type := Extra_type (System.Null_Address);

   type Table_Type is new System.Address;
   Null_Table : constant Table_Type := Table_Type (System.Null_Address);

end Pcre;

Implementation of the thin binding

In C, a string is implemented as a pointer to char terminated by a nul. Using Gnat, an Ada string is implemented with the 2 bounds first, and afterwards the content of the string.

The function Interfaces.C.New_String

   function New_String (Str : String) return chars_ptr;

This function allocates a new copy of the data and adds a terminating null. So the data are duplicated, which can be a burden when the data weight 50 Mb.

Also to avoid a memory leak, this data must be freed after use.

The procedure Match deals with :

 1/passing by reference the content of an Ada string.

Due to the difference between the Ada string and the C string, the trick is to point to the first element of the Ada String. In this case, there is no terminating nul, but as we pass the length of the data, this is no trouble.

 2/getting back a vector from the C code.

Ada allocates this vector that is used by the C code. Therefore a pragma Convention(C) is required for the vector, as well as a pragma Volatile so that the Ada compiler does not interfere/optimize it.

The whole package has been tested for memory leaks with Valgrind and does not leak.

pcre.adb

with Interfaces.C.Strings;     use Interfaces.C.Strings;
with Interfaces.C;             use Interfaces.C;
with Ada.Unchecked_Conversion;
with System;                   use System;

package body Pcre is

   pragma Linker_Options ("-lpcre");

   use Interfaces;

   function To_chars_ptr is new Ada.Unchecked_Conversion (
      Address,
      chars_ptr);

   function Pcre_Compile
     (pattern   : chars_ptr;
      option    : Options;
      errptr    : access chars_ptr;
      erroffset : access Integer;
      tableptr  : Table_Type)
      return      Pcre_Type;
   pragma Import (C, Pcre_Compile, "pcre_compile");

   function Pcre_Exec
     (code        : Pcre_Type;
      extra       : Extra_type;
      subject     : chars_ptr;
      length      : Integer;
      startoffset : Integer;
      option      : Options;
      ovector     : System.Address;
      ovecsize    : Integer)
      return        Integer;
   pragma Import (C, Pcre_Exec, "pcre_exec");

   procedure Compile
     (Matcher      : out Pcre_Type;
      Pattern      : in String;
      Option       : in Options;
      Error_Msg    : out Message;
      Last_Msg     : out Natural;
      Error_Offset : out Integer;
      Table        : in Table_Type := Null_Table)
   is
      Error_Ptr : aliased chars_ptr;
      ErrOffset : aliased Integer;
      Pat       : chars_ptr := New_String (Pattern);
   begin
      Matcher :=
         Pcre_Compile
           (Pat,
            Option,
            Error_Ptr'Access,
            ErrOffset'Access,
            Table);
      Free (Pat);

      if Matcher = Null_Pcre then
         Last_Msg                  := Natural (Strlen (Error_Ptr));
         Error_Msg (1 .. Last_Msg) := Value (Error_Ptr);
         Error_Offset              := ErrOffset;
      else
         Last_Msg     := 0;
         Error_Offset := 0;
      end if;
   end Compile;


   procedure Match
     (Result              : out Integer;
      Match_Vec           : out Match_Array;
      Matcher             : in Pcre_Type;
      Extra               : in Extra_type;
      Subject             : in String;
      Length, Startoffset : in Integer;
      Option              : in Options := 0)
   is
      Match_Size : constant Natural                     := Match_Vec'Length;
      m          : array (0 .. Match_Size - 1) of C.int := (others => 0);
      pragma Convention (C, m);
      pragma Volatile (m); -- used by the C library

      Start : constant chars_ptr :=
         To_chars_ptr (Subject (Subject'First)'Address);
   begin

      Result :=
         Pcre_Exec
           (Matcher,
            Extra,
            Start,
            Length,
            Startoffset,
            Option,
            m (0)'Address,
            Match_Size);
      for I in 0 .. Match_Size - 1 loop
         if m (I) > 0 then
            Match_Vec (I) := Integer (m (I));
         else
            Match_Vec (I) := 0;
         end if;
      end loop;
   end Match;

   type Access_Free is access procedure (Item : System.Address);
   Pcre_Free : Access_Free;
   pragma Import (C, Pcre_Free, "pcre_free");

   procedure Free (M : Pcre_Type) is
   begin
      Pcre_Free (System.Address (M));
   end Free;

end Pcre;

Test of Pcre binding

Example taken from Regex at the site Rosetta.org

test_0.adb

--
-- Basic test : splitting a sentence into words
--
with Ada.Text_IO; use Ada.Text_IO;
with Pcre;        use Pcre;

procedure Test_0 is

   procedure Search_For_Pattern
     (Compiled_Expression : in Pcre.Pcre_Type;
      Search_In           : in String;
      Offset              : in Natural;
      First, Last         : out Positive;
      Found               : out Boolean)
   is
      Result  : Match_Array (0 .. 2);
      Retcode : Integer;
   begin
      Match
        (Retcode,
         Result,
         Compiled_Expression,
         Null_Extra,
         Search_In,
         Search_In'Length,
         Offset);

      if Retcode < 0 then
         Found := False;
      else
         Found := True;
         First := Search_In'First + Result (0);
         Last  := Search_In'First + Result (1) - 1;
      end if;
   end Search_For_Pattern;

   Word_Pattern : constant String := "([A-z]+)";

   Subject          : constant String := ";-)I love PATTERN matching!";
   Current_Offset   : Natural         := 0;
   First, Last      : Positive;
   Found            : Boolean;
   Regexp           : Pcre_Type;
   Msg              : Message;
   Last_Msg, ErrPos : Natural         := 0;

begin
   Compile (Regexp, Word_Pattern, 0, Msg, Last_Msg, ErrPos);

   -- Find all the words in Subject string
   loop
      Search_For_Pattern
        (Regexp,
         Subject,
         Current_Offset,
         First,
         Last,
         Found);
      exit when not Found;
      Put_Line ("<" & Subject (First .. Last) & ">");
      Current_Offset := Last;
   end loop;

   Free (Regexp);
end Test_0;

Output :

<I>
<love>
<PATTERN>
<matching>

Complete code of the binding

The complete code of the binding and some examples can be download at sourceforge.net

Example for C++

How to use C++ functions from Ada. Please consider the following C++ code:

header file random_number.h

#ifndef GUARD_random_number_h
#define GUARD_random_number_h

#include <unistd.h>
#include <ctime>
#include <cstdlib>

void getNewSeed();
double getRandom(int a, int b);
int getRandomInt(int a, int b); 
int getRounded(double res);

#endif

source file random_number.cpp

#include <unistd.h>
#include <ctime>
#include <cstdlib>
#include "random_number.h"
#include <math.h>

using std::srand;
using std::rand;

void getNewSeed() {
       srand(time(NULL));
}

double getRandom(int a, int b) {
       return (b-a)* ( (double) rand()/RAND_MAX) + a;
}

int getRounded(double res) {
       return (res > 0.0) ? floor(res + 0.5) : ceil(res - 0.5);
}

int getRandomInt(int a, int b) {
       res = getRandom(a, b);
       return getRounded(res);
}

How can we call the C++ function getRandomInt(0,10) from an Ada program?

The solution

Start by creating an Ada specification based on the C++ header file (assuming a suitably recent GCC):

 gcc -c -fdump-ada-spec random_number.h

Or read this for examples on auto-generating Ada bindings from C and C++ headers.

Comment out the #includes in random_number.h. They are unused and they are repeated in random_number.cpp anyway. Save it as random_number.hpp. (This forces C++ style Ada specs rather than C style, which is essential to link to the C++ code). Generate the Ada specification automatically:

 /usr/gnat/bin/gcc -fdump-ada-spec random_number.hpp

This produces the file random_number_hpp.ads.

random_number_hpp.ads

with Interfaces.C; use Interfaces.C;

package random_number_hpp is

  procedure getNewSeed;  
  -- random_number.hpp:8:21 
  pragma Import (CPP, getNewSeed, "_Z14getNewSeedv");

  function getRandom (a : int; b : int) return double;
  --  random_number.hpp:9:35
  pragma Import (CPP, getRandom, "_Z14getRandomii");

  function getRandomInt (a : int; b : int) return int;
  --  random_number.hpp:10:39
  pragma Import (CPP, getRandomInt, "_Z21getRandomIntii");

  function getRounded (res : double) return int;
  -- random_number.hpp:11:26
  pragma Import (CPP, getRounded, "_Z10getRoundedd");

end random_number_hpp;

While not essential, it is recommended to write a wrapper package to hide the C interface and C types, and to make the interface look like Ada: random_wrapper.ads and random_wrapper.adb. (This constitutes a "thick binding", while package random_number_h is a thin binding). At this point you can choose what to expose to the Ada code; I have been selective (or lazy!).

random_wrapper.ads

package random_wrapper is

  procedure initialise_seed;
  function random_between(a,b : in Integer) return Integer;

end random_wrapper;

random_wrapper.adb

with random_number_hpp;
use random_number_hpp;
with Interfaces.C;
use Interfaces.C;

package body random_wrapper is

  procedure initialise_seed is
  begin
     getNewSeed;
  end initialise_seed;

  function random_between(a,b : in Integer) return Integer is begin
     return Integer(getRandomInt (int(a), int(b)));
  end random_between;

end random_wrapper;

Now write your main Ada program:

random.adb

--  Random number tester

with Ada.Text_Io;               use Ada.Text_Io;
with Ada.Integer_Text_Io;       use Ada.Integer_Text_Io; with random_wrapper;
use random_wrapper;

procedure random is

begin
  initialise_seed;
  Put("Five random numbers");
  New_Line;
  for i in 1 .. 5 loop
     Put(random_between(1,100));
     New_Line;
  end loop;
end random;

Compile the C++ portion (more complex examples may need a Makefile):

 g++ -g -m64 -c -o random_number.o random_number.cpp

Build the Ada portion:

 gnatmake -m64 -gnat05 -gnato -gnatwa -fstack-check -o random random.adb -largs ./random_number.o -lstdc++

Note additional arguments -largs ./random_number.o -lstdc++ to gnatlink; extend these if you add more C++ objects and libraries.

Run it.

 ./random
 Five random numbers
        9
       40
        2
       77
       66

Specification

--                     Standard Ada library specification
--   Copyright (c) 2003-2018 Maxim Reznik <reznikmm@gmail.com>
--   Copyright (c) 2004-2016 AXE Consultants
--   Copyright (c) 2004, 2005, 2006 Ada-Europe
--   Copyright (c) 2000 The MITRE Corporation, Inc.
--   Copyright (c) 1992, 1993, 1994, 1995 Intermetrics, Inc.
--   SPDX-License-Identifier: BSD-3-Clause and LicenseRef-AdaReferenceManual
-- -------------------------------------------------------------------------

package Interfaces.C is
   pragma Pure(C);

   --  Declarations based on C's <limits.h>

   CHAR_BIT  : constant := implementation_defined;  --  typically 8
   SCHAR_MIN : constant := implementation_defined;  --  typically -128
   SCHAR_MAX : constant := implementation_defined;  --  typically 127
   UCHAR_MAX : constant := implementation_defined;  --  typically 255

   --  Signed and Unsigned Integers
   type int   is range implementation_defined .. implementation_defined;
   type short is range implementation_defined .. implementation_defined;
   type long  is range implementation_defined .. implementation_defined;

   type signed_char is range SCHAR_MIN .. SCHAR_MAX;
   for signed_char'Size use CHAR_BIT;

   type unsigned       is mod implementation_defined;
   type unsigned_short is mod implementation_defined;
   type unsigned_long  is mod implementation_defined;

   type unsigned_char is mod (UCHAR_MAX+1);
   for unsigned_char'Size use CHAR_BIT;

   subtype plain_char is unsigned_char; --   implementation_defined;

   type ptrdiff_t is range implementation_defined .. implementation_defined;

   type size_t is mod implementation_defined;

   --  Floating Point

   type C_float     is digits implementation_defined;

   type double      is digits implementation_defined;

   type long_double is digits implementation_defined;

   --  Characters and Strings

   type char is ('x'); --   implementation_defined character type;

   nul : constant char := implementation_defined;

   function To_C   (Item : in Character) return char;

   function To_Ada (Item : in char) return Character;

   type char_array is array (size_t range <>) of aliased char;
   pragma Pack (char_array);
   for char_array'Component_Size use CHAR_BIT;

   function Is_Nul_Terminated (Item : in char_array) return Boolean;

   function To_C   (Item       : in String;
                    Append_Nul : in Boolean := True)
                   return char_array;

   function To_Ada (Item     : in char_array;
                    Trim_Nul : in Boolean := True)
                   return String;

   procedure To_C (Item       : in String;
                   Target     : out char_array;
                   Count      : out size_t;
                   Append_Nul : in Boolean := True);

   procedure To_Ada (Item     : in char_array;
                     Target   : out String;
                     Count    : out Natural;
                     Trim_Nul : in Boolean := True);

   --  Wide Character and Wide String

   type wchar_t is (' ');  --   implementation_defined char type;

   wide_nul : constant wchar_t := implementation_defined;

   function To_C   (Item : in Wide_Character) return wchar_t;
   function To_Ada (Item : in wchar_t       ) return Wide_Character;

   type wchar_array is array (size_t range <>) of aliased wchar_t;

   pragma Pack (wchar_array);

   function Is_Nul_Terminated (Item : in wchar_array) return Boolean;

   function To_C   (Item       : in Wide_String;
                    Append_Nul : in Boolean := True)
                   return wchar_array;

   function To_Ada (Item     : in wchar_array;
                    Trim_Nul : in Boolean := True)
                   return Wide_String;

   procedure To_C (Item       : in  Wide_String;
                   Target     : out wchar_array;
                   Count      : out size_t;
                   Append_Nul : in  Boolean := True);

   procedure To_Ada (Item     : in  wchar_array;
                     Target   : out Wide_String;
                     Count    : out Natural;
                     Trim_Nul : in  Boolean := True);

   --   ISO/IEC 10646:2003 compatible types defined by ISO/IEC TR 19769:2004.

   type char16_t is ('x');  --   implementation_defined character type

   char16_nul : constant char16_t := implementation_defined;

   function To_C (Item : in Wide_Character) return char16_t;

   function To_Ada (Item : in char16_t) return Wide_Character;

   type char16_array is array (size_t range <>) of aliased char16_t;
   pragma Pack (char16_array);

   function Is_Nul_Terminated (Item : in char16_array) return Boolean;

   function To_C (Item       : in Wide_String;
                  Append_Nul : in Boolean := True)
                 return char16_array;

   function To_Ada (Item     : in char16_array;
                    Trim_Nul : in Boolean := True)
                   return Wide_String;

   procedure To_C (Item       : in     Wide_String;
                   Target     :    out char16_array;
                   Count      :    out size_t;
                   Append_Nul : in     Boolean := True);

   procedure To_Ada (Item     : in     char16_array;
                     Target   :    out Wide_String;
                     Count    :    out Natural;
                     Trim_Nul : in     Boolean := True);

   type char32_t is ('x');  --   implementation_defined character type

   char32_nul : constant char32_t := implementation_defined;

   function To_C (Item : in Wide_Wide_Character) return char32_t;

   function To_Ada (Item : in char32_t) return Wide_Wide_Character;

   type char32_array is array (size_t range <>) of aliased char32_t;
   pragma Pack (char32_array);

   function Is_Nul_Terminated (Item : in char32_array) return Boolean;

   function To_C (Item       : in Wide_Wide_String;
                  Append_Nul : in Boolean := True)
                 return char32_array;

   function To_Ada (Item     : in char32_array;
                    Trim_Nul : in Boolean := True)
                   return Wide_Wide_String;

   procedure To_C (Item       : in     Wide_Wide_String;
                   Target     :    out char32_array;
                   Count      :    out size_t;
                   Append_Nul : in     Boolean := True);

   procedure To_Ada (Item     : in     char32_array;
                     Target   :    out Wide_Wide_String;
                     Count    :    out Natural;
                     Trim_Nul : in     Boolean := True);

   Terminator_Error : exception;

end Interfaces.C;