Ada DLL causes Seg Fault in system.secondary_stack.ss_mark - ada

How do I fix this Seg Fault in my DLL?
I'm generating a Windows DLL (in Ada) and using the DLL from an Ada
program. I’m using AdaCore’s GNAT GPS v6.0.1 IDE for both the DLL
and an Ada program to test the DLL, running on a Windows 7 machine.
Two separate project files are used, one for the DLL, the other for
the test driver. The DLL does not have any DLLMain nor initialization
or finalization routines.
As a first step (because I've never created a DLL or used GPS prior to this, do know some Ada though), I coded two very simple functions for the DLL. One function returns a pointer to a string, the other function returns a fixed length string.
The test program successfully calls the DLL function that returns a fixed-length
string, however when calling the function that returns a string pointer, a
segmentation fault occurs. Here is the gcc debug output:
Program received signal SIGSEGV, Segmentation fault.
0x6b81dd2c in system.secondary_stack.ss_mark () from C:\GNAT\2014\bin\libgnat-2014.dll
(gdb) quit
Here is the code:
DLL Spec
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 Body
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 File
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;
Test Driver
-- 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;

I think that the SEGV happened because your DLL wasn’t initialized. The Ada runtime system needs initialization, which in the absence of DLLs would be called up in the GNAT bind process (you may have seen calls to gnatbind or gprbind flashing up the screen).
However, you have a DLL that requires the RTS to be initialized (the part that deals with the secondary stack, which is where GNAT constructs temporary unconstrained objects such as strings); but the binder isn’t aware of this because of the way you’ve linked your program (you don’t say, but I suspect you’ve specified the DLL via -lHAGutils?).
The way to get GNAT to handle this for you is to write a project file for the test program and have it with your DLL’s project:
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;
This then makes the interfaces of HAGlib visible to test_ada_dll, so you can change it to say
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;
(note, the conversion in Text_IO.Put_Line("The Spec is -- " & String (Spec_Str)); is because Spec_Str is a derived type; I think it’s be more normal in this case to make it a subtype).
Further, you no longer need to use the pragma Exports in String_Utils’s spec.
The result of this is that the binder is aware of the properties of your HAGutils DLL, and can arrange for the necessary initializations to happen.
There is a way in which you can make your original code work, which is to use the GPR attribute Library_Auto_Init in HAGutils.gpr:
for Library_Auto_Init use “true”;
but I think you’d have to make HAGlib a proper standalone library. This is quite complex to get right, and not necessary to get the library working to start with.

Related

How can I start a process and convert its PID to/from an integer?

I'm writing a process manager in Ada, for Linux. I'm using GNAT.OS_Lib to spawn processes:
Pid := GNAT.OS_Lib.Non_Blocking_Spawn(
Program_Name => Program,
Args => Arguments
);
This gets me back the PID as a Process_Id, an OS_Lib private type. I would like to be able to store this PID in a file as an integer, for compatibility with other, non-Ada code, and then re-load it later from that file and use it from within Ada to kill the process, check its status, etc.
OS_Lib provides a Pid_To_Integer function, but not the inverse.
Perhaps I need a different library? As far as I can tell, there are no current Ada POSIX libraries. Should I write one myself? I only need support for like three POSIX calls. I'm open to all suggestions.
Chasing through the RTS for the definition, g-os_lib.ads says
with System.OS_Lib;
package GNAT.OS_Lib renames System.OS_Lib;
and at the bottom of s-os_lib.ads we find
type Process_Id is new Integer;
so I’d go for Ada.Unchecked_Conversion.
In the end, I wrote my own implementation. Here is an example of how to run execv and fork in Ada.
main.adb
with Ada.Text_IO;
with Interfaces.C.Strings;
procedure Main is
subtype C_String is Interfaces.C.Strings.chars_ptr;
Null_String: C_String := Interfaces.C.Strings.Null_Ptr;
function As_C_String(s: String) return C_String renames Interfaces.C.Strings.New_String;
type Argument_List is Array(1..2) of C_String;
function Execute(Program: C_String; Arguments: Argument_List) return Integer
with Import => True, Convention => C, External_Name => "execv";
function Fork return Integer
with Import => True, Convention => C, External_Name => "fork";
Program: C_String := As_C_String("/bin/sh");
Args: Argument_List := (Program, Null_String);
N : Integer;
Pid: Integer;
begin
Pid := Fork;
if Pid = 0
then
N := Execute(Program, Args);
else
Ada.Text_IO.Put_Line(Pid'Image);
end if;
end Main;
main.gpr
project Main is
for Languages use ("ada");
for Source_Dirs use (".");
for Main use ("main.adb");
for Object_Dir use "obj";
for Exec_Dir use ".";
end Main;
Compiling with gprbuild and it works fine. Run main and you should see an integer in the console, run ps ux and you should see an instance of sh running with that PID.

Passing string constant or literal to GCC built-ins in Ada

I've use a few intrinsics before with GNAT, but I get an error for __builtin_cpu_is when trying to pass in an Chars_Ptr:
error: parameter to builtin must be a string constant or literal
I also tried plugging the "amd" target parameter in directly, but that didn't work.
with Ada.Text_IO;
with Interfaces.C.Strings;
procedure Intrinsics is
procedure CPU_Init;
pragma Import (Intrinsic, CPU_Init, "__builtin_cpu_init");
function Is_CPU (CPU_Name : Interfaces.C.Strings.chars_ptr) return Interfaces.C.Int;
pragma Import (Intrinsic, Is_CPU, "__builtin_cpu_is");
Target : constant Interfaces.C.Strings.Chars_Ptr := Interfaces.C.Strings.New_String ("amd");
begin
CPU_Init;
-- ERROR from the below line, from Is_CPU
Ada.Text_IO.Put_Line (Interfaces.C.Int'Image (Is_CPU (Target)));
end Intrinsics;
References I've been looking at:
GCC Built-ins
Learn Ada, Interfacing w/ C
I think you hit a (current) limitation in importing GCC intrinsics in Ada programs (at least for version GCC/GNAT FSF 11.2). The best workaround is to wrap the builtin/intrinsic with string literal in a C function and then import that C wrapper function in the Ada program.
The error is thrown by the GCC back-end (see here). The built-in only accepts a string literal. This is not clear from the equivalent C signature of the built-in. The equivalent C signature suggests that any constant pointer-to-char is accepted:
int __builtin_cpu_is (const char *cpuname)
However, a simple test shows that this works:
#include <stdbool.h>
bool is_amd() {
return __builtin_cpu_is("amd") != 0;
}
But this doesn't:
#include <stdbool.h>
bool is_cpu(const char *cpuname) {
return __builtin_cpu_is(cpuname) != 0;
}
During compilation the abstract syntax tree is analyzed and the reference to the built-in is being matched along with the actual parameter that is passed in. This actual parameter must be a string literal (a specific tree node type). The string literal is then parsed/matched by GCC. Upon success, the call to the built-in in the syntax tree is (as a whole) replaced by a comparison (done here).
$ gcc -c is_amd.c --dump-tree-original && cat is_amd.c.005t.original
;; Function is_amd (null)
;; enabled by -tree-original
{
return __cpu_model.__cpu_vendor == 2 ? 1 : 0;
}
Now, it seems that the GNAT front-end is currently unable to generate the exact nodes (or node pattern) in the syntax tree that will match those expected by the built-in parser. This is likely because of the declared signature of the built-in and the fact that Ada makes a clear distinction between string values and string pointers.
The GNAT front-end compares the binding to __builtin_cpu_is with the signature declared internally by the GCC back-end and concludes that the cpuname argument must be a constant pointer-to-string. So, something like this:
function Is_CPU (CPU_Name : access constant String) return Integer;
pragma Import (Intrinsic, Is_CPU, "__builtin_cpu_is");
However, when using this signature, you cannot pass a string literal directly; you must use some indirection:
AMD : aliased constant String := "amd"
and then
Is_CPU (AMD'Access);
This indirection is (as far as I can see) preserved before the GNAT front-end hands over the syntax tree to the GCC back-end; GNAT will not "inline" the string literal (that is: will not remove the indirection; which I guess is actually a good thing as you do not want a constant string to be inlined into function calls in general: multiple functions might reference the string and if the string is very big, the effect of inlining might cause the program size to grow significantly).
On the other hand, if you want to pass a string literal directly in Ada, then you need a signature similar to
function Is_CPU (CPU_Name : String) return Integer;
pragma Import (Intrinsic, Is_CPU, "__builtin_cpu_is");
This signature, however, conflicts with the signature declared by the GCC back-end. Moreover, the GNAT front-end will complain that a string literal cannot be passed-by-copy (something that is likely required for the call to be accepted and recognized by the back-end).
So, I guess some additional logic for handling GCC built-ins with string arguments would have to be added to the GNAT front-end in order for this to work and allow something like this to compile:
function Is_AMD return Boolean is
function Is_CPU (CPU_Name : String) return Integer;
pragma Import (Intrinsic, Is_CPU, "__builtin_cpu_is");
begin
return Is_CPU ("amd") /= 0;
end Is_AMD;
Until then, wrapping the intrinsic with string literal in a separate C function (like the is_amd() example above) and then importing this C wrapper function in the Ada program will be the way to go.
Eric found a working solution:
with Ada.Unchecked_Conversion;
with Ada.Text_IO;
with Interfaces.C.Strings;
procedure Main is
procedure CPU_Init;
pragma Import (Intrinsic, CPU_Init, "__builtin_cpu_init");
function Is_CPU (CPU_Name : Interfaces.C.Strings.chars_ptr) return Integer;
pragma Import (Intrinsic, Is_CPU, "__builtin_cpu_is");
function To_Chars_Ptr is
new Ada.Unchecked_Conversion (String, Interfaces.C.Strings.chars_ptr);
begin
CPU_Init;
Ada.Text_IO.Put_Line (Integer'Image (Is_CPU (To_Chars_Ptr ("intel"))));
end;
How about trying Target as shown below
Target : constant Interfaces.C.Char_Ptr := Interfaces.C.To_C ("amd");

Ada: Manipulate a private type

I'm kinda new with Ada and recently got an error that I don't seem to know how to solve.
I have the following code:
data.ads
with Text_IO; use text_io;
with ada.Integer_Text_IO; use ada.Integer_Text_IO;
package data is
type file is private;
type file_set is array (Integer range <>) of file;
procedure file_Print (T : in out file); --Not used
private
type file is record
start, deadline : integer;
end record;
end data;
Main.adb
with ada.Integer_Text_IO; use ada.Integer_Text_IO;
procedure Main is
Num_files: integer:=3;
Files:file_set(1..Num_files);
begin
Files(1):=(2,10); -- Expected private type "file" defined at data.ads
for i in 1..Num_Files loop
Put(integer'Image(i));
New_Line;
data.File_Print(Files(i));
But I'm getting this error Expected private type "file" defined at data.ads
How can I access the file type and declare a new array of values in main?
That's right - you don't get to see or manipulate what's inside a private type. That would be breaking encapsulation. Bugs and security risks follow.
You can only interact with a private type via its methods : functions and procedures declared in the package where it's declared.
Now file_set is NOT a private type (you might consider making it private later, for better encapsulation, but for now ....) you can index it to access a file within it (using one of those procedures).
Files(1):=(2,10);
As you want to create a file here, you need a method to create a file ... a bit similar to a constructor in C++, but really more like the Object Factory design pattern. Add this to the package:
function new_file(start, deadline : integer) return file;
And implement it in the package body:
package body data is
function new_file(start, deadline : integer) return file is
begin
-- check these values are valid so we can guarantee a proper file
-- I have NO idea what start, deadline mean, so write your own checks!
-- also there are better ways, using preconditions in Ada-2012
-- without writing explicit checks, but this illustrates the idea
if deadline < NOW or start < 0 then
raise Program_Error;
end if;
return (start => start, deadline => deadline);
end new_file;
procedure file_Print (T : in out file) is ...
end package body;
and that gives the users of your package permission to write
Files(1):= new_file(2,10);
Files(2):= new_file(start => 3, deadline => 15);
but if they attempt to create garbage to exploit your system
Files(3):= new_file(-99,-10); -- Oh no you don't!
this is the ONLY way to create a file, so they can't bypass your checks.

Start executable from Ada program and read result

I found this question and the first answer contains some example code demonstrating how to start an executable with Ada code. The output of the executable is written to the standard output.
What options do I have to read the output of the executable for further parsing/processing in Ada (for example line by line)?
If you use GNAT, then you might want to take a look at Get_Command_Output in the GNAT.Expect package. Here's an example:
with Ada.Text_IO, GNAT.Expect;
procedure Main is
Command : constant String := "gnat";
Argument_1 : aliased String := "--version";
Input : constant String := "";
Status : aliased Integer := 0;
-- Execute the command and retrieve the output.
Output : String :=
GNAT.Expect.Get_Command_Output
(Command => Command,
Arguments => (1 => Argument_1'Unchecked_Access),
Input => Input,
Status => Status'Access,
Err_To_Out => False);
-- NOTE: Cheating with Unchecked_Access, OK for demo. You may want
-- to properly new and Free these strings (see Argument_List
-- type in package GNAT.OS_Lib).
begin
Ada.Text_IO.Put_Line (Output);
end Main;
The program returns after execution:
$ ./main
GNAT Community 2019 (20190517-83)
Copyright (C) 1996-2019, Free Software Foundation, Inc.
This is free software; see the source for copying conditions.
There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
As can be seen, the result is returned as a single string. You will have do the line splitting yourself.
Update
An update in response to some comments below.
You might also consider using the system function if you're targeting the Windows platform (see also this post on SO). Quoting from the function reference:
The system function passes command to the command interpreter, which executes the string as an operating-system command.
This is similar to what the program cmd.exe does. You can obtain the output of the command by redirecting its output to a file (i.e. using >) and then subsequently read it back. Here's an example:
with Ada.Text_IO;
with Ada.Text_IO.Unbounded_IO;
with Ada.Strings.Unbounded;
with Interfaces.C;
with Interfaces.C.Strings;
procedure Main is
use Ada.Strings.Unbounded;
Content : Unbounded_String := Null_Unbounded_String;
begin
-- Execute.
declare
use Interfaces.C;
use Interfaces.C.Strings;
function system (command : chars_ptr) return int
with Import, Convention => C, External_Name => "system";
command : chars_ptr := New_String("gnat --version > gnat_version.out");
result : int := system (command);
begin
-- Check value of result (omitted in this example).
Free(Command);
end;
-- Read.
declare
use Ada.Text_IO;
use Ada.Text_IO.Unbounded_IO;
Fd : File_Type;
begin
Open (Fd, In_File, "./gnat_version.out");
while not End_Of_File (Fd) loop
Content := Content
& Unbounded_String'(Get_Line (Fd))
& ASCII.CR & ASCII.LF; -- Restore the line break removed by Get_Line.
end loop;
Close (fd);
end;
-- Show.
Ada.Text_IO.Unbounded_IO.Put (Content);
end Main;

Ada elaboration not occurring at all

I have an unusual situation in which elaboration code is simply not being executed at all. This is not an elaboration order issue, but rather an elaboration at all issue.
The problem is that I don't "with" the unit in question whatsoever, yet in theory it should still be accessible, as long as its elaboration occurs.
Of course I could just add a useless "with" for the unit in question, but in my real use case there are a large number of units that I would have to do that with.
My question is if there is any way either in the code, through pragmas, in the gpr project file, or through command-line switches that I could force the compiler to include a file even though it thinks the file isn't referenced?
Here is a minimal working example:
as.ads:
package As is
type A is tagged null record;
type Nothing is null record;
function Create (Ignored : not null access Nothing) return A;
function Image (From : A) return String;
end As;
as.adb:
package body As is
function Create (Ignored : not null access Nothing) return A is
(null record);
function Image (From : A) return String is ("A");
end As;
finder.ads:
with Ada.Tags;
package Finder is
procedure Register (Name : String; Tag : Ada.Tags.Tag);
function Find (Name : String; Default : Ada.Tags.Tag) return Ada.Tags.Tag;
end Finder;
finder.adb:
with Ada.Containers.Indefinite_Vectors;
package body Finder is
type Name_Tag (Size : Natural) is
record
Name : String (1 .. Size);
To : Ada.Tags.Tag;
end record;
package Name_Tag_Vectors is new Ada.Containers.Indefinite_Vectors (Positive, Name_Tag);
Name_Tags : Name_Tag_Vectors.Vector := Name_Tag_Vectors.Empty_Vector;
procedure Register (Name : String; Tag : Ada.Tags.Tag) is begin
Name_Tags.Append ((Name'Length, Name, Tag));
end Register;
function Find (Name : String; Default : Ada.Tags.Tag) return Ada.Tags.Tag is begin
for Tag of Name_Tags loop
if Tag.Name = Name then
return Tag.To;
end if;
end loop;
return Default;
end Find;
end Finder;
bs.ads:
with As;
package Bs is
type B is new As.A with null record;
function Create (Ignored : not null access As.Nothing) return B;
function Image (From : B) return String;
end Bs;
bs.adb:
with Finder;
package body Bs is
function Create (Ignored : not null access As.Nothing) return B is
(As.Create (Ignored) with null record);
function Image (From : B) return String is ("B");
begin
Finder.Register ("B", B'Tag);
end Bs;
test.adb:
with As; use As;
-- with Bs; -- (uncommenting this line solves my problem, but what if I had the rest of the alphabet?)
with Finder;
with Ada.Tags.Generic_Dispatching_Constructor;
with Ada.Text_IO;
procedure Test is
function Constructor is new Ada.Tags.Generic_Dispatching_Constructor (
T => A,
Parameters => Nothing,
Constructor => Create);
Nada : aliased Nothing := (null record);
What : A'Class := Constructor (Finder.Find ("B", A'Tag), Nada'Access);
begin
Ada.Text_IO.Put_Line (What.Image);
end Test;
The compiler thinks your package Bs isn't referenced because it isn't. You don't have a with clause for it, so it's not part of your program.
A simple example:
a.ads
package A is
procedure Blah;
end A;
a.adb
with Ada.Text_IO;
package body A is
procedure Blah is begin null; end Blah;
begin
Ada.Text_IO.Put_Line("Elaborate A");
end A;
b.ads
package B is
procedure Blah;
end B;
b.adb
with Ada.Text_IO;
package body B is
procedure Blah is begin null; end Blah;
begin
Ada.Text_IO.Put_Line("Elaborate B");
end B;
main.adb
with Ada.Text_IO;
with A;
procedure Main is
begin
Ada.Text_IO.Put_Line("Main");
end Main;
When I run main, it prints
Elaborate A
Main
It doesn't print Elaborate B because that package isn't part of the program; it's just a couple of source files in the same directory.
The obvious solution is to add the with clauses.
I don't know whether there's a less obvious solution. If there is, it's probably compiler-specific. But I'm not sure why a compiler would have a feature that lets you incorporate an otherwise unused package into a program.
What I’ve done (e.g. here ff) is to actually reference the units in the main program (with pragma Unreferenced to prevent warnings).
Alternatively, you could have a package e.g. Required_Units with all the necessary withs included, and then with that from the main program.
Even if there was some alternative process, you’d have to tell it what units you need to have included; might as well go with the flow and do it in Ada!
Since the package Bs is invisible to your program, so is the type B.
So the next question is: why do you need to register type B if it is not used anywhere?
If an Ada compiler did elaborate all units (packages or standalone subprograms) that are irrelevant to a main program, but are visible through source path, it would become really messy!...

Resources