Ada Programming/Libraries/Interfaces.C

Interfaces.C __TOC__ 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 occurred. 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 Convention(C) is required for the vector, as well as a 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 double_dot .. implementation_defined; type short is range implementation_defined double_dot .. implementation_defined; type long is range implementation_defined double_dot .. implementation_defined; type signed_char is range SCHAR_MIN double_dot .. 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 double_dot .. 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 box <>) 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 box <>) 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 box <>) 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 box <>) 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 Interfacesdot .C; See also Wikibook Ada Programming/Libraries/Interfaces Ada Programming/Libraries/Interfaces.C.Strings Ada Reference Manual Ada 95 B 3 Interfacing with C Ada 2005 B 3 Interfacing with C and C++ Ada 2012 B 3 Interfacing with C and C++ Open-Source Implementations i-c.ads i-c.adb interfaces/i-c.ads interfaces/i-c.adb