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

另請參見

華夏公益教科書

• Ada 程式設計/庫/介面
• Ada 程式設計/庫/介面.C.字串

外部示例

• 在以下位置搜尋 Interfaces.C 的 示例：Rosetta Code，GitHub (gists)，任何 Alire 包 或 此華夏公益教科書。
• 在以下位置搜尋與 Interfaces.C 相關的 帖子：Stack Overflow，comp.lang.ada 或 任何與 Ada 相關的頁面。

Ada 參考手冊

Ada 95

• B.3: 與 C 介面 ^[註釋]

Ada 2005

• B.3: 與 C 和 C++ 介面 ^[註釋]

Ada 2012

• B.3: 與 C 和 C++ 介面 ^[註釋]

開源實現

FSF GNAT

• 規範：i-c.ads
• 主體：i-c.adb

drake

• 規範：interfaces/i-c.ads
• 主體：interfaces/i-c.adb