Ada 编程/库/接口.C

计算 » 计算机科学 » 计算机编程 » Ada 编程

此语言功能从 Ada 95 开始可用。

接口.C 是预定义语言环境自 Ada 95 以来的一部分。

让我们通过两个示例来了解这个包及其子包的使用，一个用于 C 语言，另一个用于 C++。

C 语言示例

PCRE 是一个流行的 C 语言库，它使用与 Perl 5 相同的语法和语义来实现正则表达式模式匹配。PCRE 代表 Perl 兼容正则表达式。该库的网站是 pcre.org

在 Gnat 中，有用于正则表达式的 Ada 库：Unix 风格：GNAT.Regexp，GNAT.Regpat 和 Spitbol 风格：GNAT.Spitbol.

作为替代方案，与 PCRE 的接口将展示一些处理 C 语言库的技术。包 Interfaces.C.Strings 中有足够的原语来避免 C 语言包装器。

头文件 pcre.h 摘要

使用文件版本 8.02。头文件很长，我们只使用 2 种类型和 4 个操作，所以我们只需要

/* 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 ''');

瘦绑定接口

接口的目的是隐藏对包 Interfaces.C 的依赖关系，以及接口公开的类型：Integer、String、Pcre_Type、Extra_type（以及完整绑定中的 System.Address）。

类型 Pcre 和 Extra 是不透明的指针，不应在接口外部访问，因此它们被设为私有。对 pcre_extra 的组件没有必要进行操作，因此 pcre 和 pcre_extra 只被声明为 System.Address。

PCRE 中的完整循环是（编译/学习/执行），其中 Gnat.Regex 有两个阶段（编译/匹配）；学习阶段是对模式的优化，它输出一个类型为 Extra 的对象。在这里，我们绕过学习阶段。

编译分配并返回一个指向已编译模式的指针，如果发生错误，则该指针为 null。在这种情况下，错误消息和错误位置也可用。

Free 用于释放已编译模式。

Match 将已编译模式和要解析的主题 Ada 字符串作为输入。字符串的 length 参数在部分扫描的情况下是必需的。

procedure Match 输出一个返回值（Result），如果不存在匹配项或发生错误，则该返回值为负数。对于零或正返回值，match_array 与 C 语言库具有相同的输出。

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;

瘦绑定实现

在 C 语言中，字符串被实现为指向以 null 结尾的 char 的指针。使用 Gnat，Ada 字符串被实现为首先具有两个边界，然后是字符串的内容。

函数 Interfaces.C.New_String

   function New_String (Str : String) return chars_ptr;

此函数分配数据的副本并添加一个终止 null。因此数据被复制，当数据重量为 50 Mb 时，这可能会很繁重。

此外，为了避免内存泄漏，必须在使用后释放这些数据。

过程 Match 处理

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

由于 Ada 字符串和 C 字符串之间的差异，技巧是指向 Ada 字符串的第一个元素。在这种情况下，不存在终止 null，但是由于我们传递了数据的长度，因此没有问题。

 2/getting back a vector from the C code.

Ada 分配了这个向量，它被 C 代码使用。因此，向量需要一个 pragma Convention(C)，以及一个pragma Volatile，以便 Ada 编译器不干扰/优化它。

整个包已使用 Valgrind 测试内存泄漏，并且没有泄漏。

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;

Pcre 绑定的测试

从 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;

输出

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

绑定的完整代码

绑定和一些示例的完整代码可以在 sourceforge.net 上下载。

C++ 示例

如何在 Ada 中使用 C++ 函数。请考虑以下 C++ 代码

头文件 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

源文件 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);
}

我们如何在 Ada 程序中调用 C++ 函数 getRandomInt(0,10)？

解决方案

首先，基于 C++ 头文件创建一个 Ada 规范（假设是最近的 GCC）

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

或者阅读这里，了解从 C 和 C++ 头文件自动生成 Ada 绑定的示例。

注释掉 random_number.h 中的 #includes。它们未被使用，并且在 random_number.cpp 中重复出现。将其保存为 random_number.hpp。（这会强制使用 C++ 风格的 Ada 规范而不是 C 风格，这对链接到 C++ 代码至关重要）。自动生成 Ada 规范

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

这将生成文件 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;

虽然不是必须的，但建议编写一个包装程序包来隐藏 C 接口和 C 类型，并使接口看起来像 Ada：random_wrapper.ads 和 random_wrapper.adb。（这构成了“厚绑定”，而包 random_number_h 是“薄绑定”。在这一点上，您可以选择向 Ada 代码公开什么内容；我选择了（或者说是偷懒了！）。

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;

现在编写您的主要 Ada 程序

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;

编译 C++ 部分（更复杂的示例可能需要 Makefile）

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

构建 Ada 部分

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

请注意 gnatlink 的附加参数 -largs ./random_number.o -lstdc++；如果您添加了更多 C++ 对象和库，请扩展这些参数。

运行它。

 ./random
 Five random numbers
        9
       40
        2
       77
       66

规范

--                     Standard Ada library specification
--   Copyright (c) 2003-2018 Maxim Reznik <[email protected]>
--   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;

另请参见

维基教科书

外部示例

在以下位置搜索 Interfaces.C 的示例：Rosetta Code，GitHub (gists)，任何 Alire 包或此维基教科书。
在以下位置搜索与 Interfaces.C 相关的帖子：Stack Overflow，comp.lang.ada 或任何与 Ada 相关的页面。

Ada 参考手册

开源实现

FSF GNAT

规范：i-c.ads
主体：i-c.adb

drake

规范：interfaces/i-c.ads
主体：interfaces/i-c.adb