Ada DLL 导致 system.secondary_stack.ss_mark 中的 Seg 错误

Question

如何修复DLL中的此Seg错误？

我正在生成一个Windows DLL（在Ada中）并使用来自Ada的DLL程序。我正在使用AdaCore的GNAT GPS v6.0.1 IDE作为DLL以及一个用于测试DLL的Ada程序，该程序在Windows 7机器上运行。使用两个单独的项目文件，一个用于 DLL，另一个用于测试驱动程序。DLL 没有任何 DLLMain 或初始化或定型例程。

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

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

Program received signal SIGSEGV, Segmentation fault.
0x6b81dd2c in system.secondary_stack.ss_mark () from C:GNAT2014binlibgnat-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 Export s。

---

这样做的结果是，绑定程序知道HAGutils DLL 的属性，并且可以安排进行必要的初始化。

---

有一种方法可以使原始代码工作，即使用HAGutils.gpr中的GPR属性Library_Auto_Init：

for Library_Auto_Init use “true”;

但我认为你必须HAGlib成为一个合适的独立库。这很难正确处理，并且不需要让库开始工作。