Ada DLL 导致 system.secondary_stack.ss_mark 中的 Seg Fault

Question

如何在我的 DLL 中修复这个 Seg Fault？

我正在生成一个 Windows DLL（在 Ada 中）并使用来自 Ada 的 DLL 程序。我对这两个 DLL 都使用了 AdaCore 的 GNAT GPS v6.0.1 IDE 和一个用于测试 DLL 的 Ada 程序，在 Windows 7 机器上运行。 使用了两个独立的项目文件，一个用于 DLL，另一个用于 测试驱动程序。 DLL 没有任何 DLLMain 也没有初始化 或完成例程。

作为第一步（因为在此之前我从未创建过 DLL 或使用过 GPS，尽管了解一些 Ada），我为 DLL 编写了两个非常简单的函数。一个函数返回一个指向字符串的指针，另一个函数返回一个固定长度的字符串。

测试程序成功调用返回固定长度的DLL函数 字符串，但是当调用返回字符串指针的函数时， 发生分段错误。这是 gcc 调试输出：

Program received signal SIGSEGV, Segmentation fault.
0x6b81dd2c in system.secondary_stack.ss_mark () from C:\GNAT\2014\bin\libgnat-2014.dll
(gdb) quit

代码如下：

DLL 规范

with Ada.Strings.Fixed;            use Ada.Strings.Fixed;

package String_Utils is
   type String_Ptr_T is access String;
   type Spec_Str is new String (1..7);

   function Int_Trim_Left( IntToTrim : Integer) return String_Ptr_T;
   pragma Export(DLL, Int_Trim_Left, "String_Utils__Int_Trim_Left");

   function Spec( Input_Int : Integer) return Spec_Str;
   pragma Export(DLL, Spec, "String_Utils__Spec");

end String_Utils;

DLL 主体

package body String_Utils is

   function Int_Trim_Left( IntToTrim : Integer) return String_Ptr_T is
      String_Ptr   : String_Ptr_T;
   begin
      Text_IO.Put_Line("About to call new String in DLL.");
      String_Ptr := new String'(
                               Ada.Strings.Fixed.Trim(Integer'Image(IntToTrim),
                                  Ada.Strings.Left));
      return String_Ptr;
   end;
   --
   function Spec( Input_Int : Integer) return Spec_Str
   is
      Result_Spec : String := "ABC-UNK";
   begin
      case Input_Int is
         when 1 => return "ABC-STD"; -- Standard
         when 2 => return "ABC-PRF"; -- Performance
         when 3 => return "DEF-DTL"; -- Detailed
         when Others => return "ABC-UNK";
      end case;
   end;

DLL 项目文件

project HAGUtils is

   for Library_Name use "HAGUtils";
   for Library_Dir use "libdir";
   for Library_Version use "0.01";
   for Library_Kind use "dynamic";
   for Object_Dir use "obj";
   for Source_Dirs use ("src");
   for Source_Files use ("string_utils.adb", "string_utils.ads");

end HAGUtils;

测试驱动程序

-- Driver for DLL
with Text_IO;                       use Text_IO;

procedure test_ada_dll is

   type String_Ptr_T is access String;
   subtype String7 is String(1..7);

   input_val      : Integer := 0;
   Spec_Str       : String7 := (Others => ' ');
   Int_String_Ptr : String_Ptr_T:= null;

   -- Import
   function Int_Trim_Left ( IntToTrim : Integer) return String_Ptr_T
   is
      function Inner_Int_Trim_Left ( IntToTrim : Integer) return String_Ptr_T;
      pragma Import (DLL, Inner_Int_Trim_Left, "String_Utils__Int_Trim_Left");

   begin
      return Inner_Int_Trim_Left (IntToTrim);
   end Int_Trim_Left;

   -- Import
   function Spec ( Input_Int : Integer) return String7
   is
      function Inner_Spec ( Input_Int : Integer) return String7;
      pragma Import (DLL, Inner_Spec, "String_Utils__Spec");

   begin
      return Inner_Spec (Input_Int);
   end Spec;

begin
   input_val := 3;
   Spec_Str := Spec(input_val);
   Text_IO.Put_Line("The Spec is -- " & Spec_Str);

   Text_IO.Put_Line("Calling Int_Trim_Left with --" & Integer'Image(input_val));
   Int_String_Ptr :=  Int_Trim_Left(input_val);
   Text_IO.Put_Line("After call  --" & Int_String_Ptr.all);
end;

Answer 1

我认为 SEGV 发生是因为您的 DLL 未初始化。 Ada 运行时系统需要初始化，在没有 DLL 的情况下将在 GNAT 绑定过程中调用（您可能已经看到对 gnatbind 或 gprbind 的调用在屏幕上闪烁）。

但是，您有一个需要初始化 RTS 的 DLL（处理辅助堆栈的部分，这是 GNAT 构造临时不受约束的对象，例如字符串的地方）；但是由于您链接程序的方式，活页夹没有意识到这一点（您没有说，但我怀疑您已经通过-lHAGutils 指定了 DLL？）。

让 GNAT 为您处理此问题的方法是为测试程序编写一个项目文件并将其 with 您的 DLL 的项目：

with "HAGutils";
project Test_Ada_Dll is
for Main use ("test_ada_dll.adb");
  for Exec_Dir use ".";
  for Source_Files use ("test_ada_dll.adb");
  for Object_Dir use ".build";
end Test_Ada_Dll;

这使得HAGlib的接口对test_ada_dll可见，所以你可以把它改成说

with Text_IO;                       use Text_IO;
with String_Utils;

procedure test_ada_dll is

   input_val      : Integer := 0;
   Spec_Str       : String_Utils.Spec_Str := (Others => ' ');
   Int_String_Ptr : String_Utils.String_Ptr_T:= null;

begin
   input_val := 3;
   Spec_Str := String_Utils.Spec(input_val);
   Text_IO.Put_Line("The Spec is -- " & String (Spec_Str));

   Text_IO.Put_Line("Calling Int_Trim_Left with --" & Integer'Image(input_val));
   Int_String_Ptr :=  String_Utils.Int_Trim_Left(input_val);
   Text_IO.Put_Line("After call  --" & Int_String_Ptr.all);
end;

（注意，Text_IO.Put_Line("The Spec is -- " & String (Spec_Str)); 中的转换是因为Spec_Str 是派生类型；我认为在这种情况下将其设为子类型更正常）。

此外，您不再需要在 String_Utils 的规范中使用 pragma Exports。

---

这样做的结果是绑定器知道您的HAGutils DLL 的属性，并且可以安排发生必要的初始化。

---

有一种方法可以让你的原始代码工作，那就是在HAGutils.gpr 中使用GPR 属性Library_Auto_Init：

for Library_Auto_Init use “true”;

但我认为您必须将 HAGlib 设为正确的 standalone library。正确处理这件事相当复杂，而且没有必要让库开始工作。