Interfaces.C questions

Interfaces.C questions

[hreba]

These are my first steps with Interfaces.C:

----------------------------------------------------------------------
with Interfaces.C;

package GSL is

    package C renames Interfaces.C;

    type size_t is new C.int;
    type Real_Function is access function (x: C.double) return C.double;

    function Bessel_J0 (x: C.double) return C.double;

    function Integration_QNG
      (f: Real_Function;
       a, b, epsabs, epsrel: C.double;
       result, abserr: out C.double;
       neval: out size_t)
      return C.int;

private

    pragma Import (C, Bessel_J0,		"gsl_sf_bessel_J0");
    pragma Import (C, Integration_QNG,	"gsl_integration_qng");

end GSL;
------------------------------------------------------------------------

No problem with function Bessel_J0. But Integration_QNG gets me:

gsl.ads:19:07: functions can only have "in" parameters.

The C prototype of this function is:

int gsl_integration_qng (const gsl function * f , double a , double b ,
double epsabs , double epsrel , double * result , double * abserr , size 
t * neval )

So my questions are:

1. How do I translate C functions which return non-void and which 
additionally use pointers for out parameters? Do I have to use pointers 
in my Ada program?

2. On my platform size_t is C.int. How can I define size_t in a 
platform-independent way?

3. The C function above needs a pointer to a function as parameter. Is 
my translation to Ada correct?

-- 
Frank Hrebabetzky		+49 / 6355 / 989 5070

Re: Interfaces.C questions

[Niklas Holsti]

On 17-03-17 23:12 , hreba wrote:
> These are my first steps with Interfaces.C:
>
> ----------------------------------------------------------------------
> with Interfaces.C;
>
> package GSL is
>
>    package C renames Interfaces.C;
>
>    type size_t is new C.int;
>    type Real_Function is access function (x: C.double) return C.double;
>
>    function Bessel_J0 (x: C.double) return C.double;
>
>    function Integration_QNG
>      (f: Real_Function;
>       a, b, epsabs, epsrel: C.double;
>       result, abserr: out C.double;
>       neval: out size_t)
>      return C.int;
>
> private
>
>    pragma Import (C, Bessel_J0,        "gsl_sf_bessel_J0");
>    pragma Import (C, Integration_QNG,    "gsl_integration_qng");
>
> end GSL;
> ------------------------------------------------------------------------
>
> No problem with function Bessel_J0. But Integration_QNG gets me:
>
> gsl.ads:19:07: functions can only have "in" parameters.
>
> The C prototype of this function is:
>
> int gsl_integration_qng (const gsl function * f , double a , double b ,
> double epsabs , double epsrel , double * result , double * abserr , size
> t * neval )
>
> So my questions are:
>
> 1. How do I translate C functions which return non-void and which
> additionally use pointers for out parameters? Do I have to use pointers
> in my Ada program?

Using pointers is possible, but functions with "out" or "in out" 
parameters are allowed in the Ada 2012 standard. Check your compiler; it 
may by default use the Ada 2005 rules and may need a command-line option 
(perhaps -gnat2012) to use Ada 2012 rules.

> 2. On my platform size_t is C.int. How can I define size_t in a
> platform-independent way?

Don't define it; use Interfaces.C.size_t.

> 3. The C function above needs a pointer to a function as parameter. Is
> my translation to Ada correct?

Looks ok to me, but you didn't show the C prototype of the function (the 
gsl_function type?) so I can't compare the two.

-- 
Niklas Holsti
Tidorum Ltd
niklas holsti tidorum fi
       .      @       .

Re: Interfaces.C questions

[Jeffrey R. Carter]

On 03/17/2017 10:12 PM, hreba wrote:
>
> 1. How do I translate C functions which return non-void and which additionally
> use pointers for out parameters? Do I have to use pointers in my Ada program?

Ada before Ada 12 only allows "in" parameters for functions. If using such a 
compiler, you'll have to use pointers on the Ada side as well. If you have an 
Ada-12 compiler (currently only GNAT), then functions can have "in out" and 
"out" parameters, which are better for this case.

> 2. On my platform size_t is C.int. How can I define size_t in a
> platform-independent way?

Use Interfaces.C.size_t.

> 3. The C function above needs a pointer to a function as parameter. Is my
> translation to Ada correct?

You should declare that your access type is convention C:

pragma Convention (C, Real_Function);

-- 
Jeff Carter
"Apart from the sanitation, the medicine, education, wine,
public order, irrigation, roads, the fresh water system,
and public health, what have the Romans ever done for us?"
Monty Python's Life of Brian
80

Re: Interfaces.C questions

[Dmitry A. Kazakov]

On 2017-03-17 22:12, hreba wrote:
> These are my first steps with Interfaces.C:
>
> ----------------------------------------------------------------------
> with Interfaces.C;
>
> package GSL is
>
>    package C renames Interfaces.C;

Renaming packages is a bad idea. Either use fully-qualified names 
"Interfaces.C.size_t" or else do use-clause "size_t". Renaming lacks 
advantages of either approach inheriting their corresponding disadvantages.

>    type size_t is new C.int;

size_t is defined in Interfaces.C.

>    type Real_Function is access function (x: C.double) return C.double;

pragma Convention (C, Real_Function);

>    function Bessel_J0 (x: C.double) return C.double;
>
>    function Integration_QNG
>      (f: Real_Function;
>       a, b, epsabs, epsrel: C.double;
>       result, abserr: out C.double;
>       neval: out size_t)
>      return C.int;

     function Integration_QNG
       (f: Real_Function;
        a, b, epsabs, epsrel: Interfaces.C.double;
        result, abserr: access Interfaces.C.double;
        neval: access Interfaces.C.size_t)
       return Interfaces.C.int;

P.S. For convention C assume this:

1. out T, in out T, access T are equivalent

2. in T and access T are equivalent when T is non-scalar (you can pass 
int, array, or record, the compiler will sort that out)

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de

Re: Interfaces.C questions

[hreba]

Instead of answering individually to each of you, I respond to my own 
posting. Thanks to your help I was able to compile the corrected version 
of my program. Execution generated a stack overflow. Reason was my wild 
guess about the C type "gsl_function". In the GSL (GNU Scientific 
Library) reference manual it is explained only through examples. Finally 
I found its definition in the header file gsl_math.h:

struct gsl_function_struct
{
   double (* function) (double x, void * params);
   void * params;
};
typedef struct gsl_function_struct gsl_function ;

Can anybody please tell me how to translate this into Ada? I have no 
idea how to handle the void pointers.
-- 
Frank Hrebabetzky		+49 / 6355 / 989 5070

Re: Interfaces.C questions

[Jeffrey R. Carter]

On 03/18/2017 04:46 PM, hreba wrote:
>
> struct gsl_function_struct
> {
>   double (* function) (double x, void * params);
>   void * params;
> };
> typedef struct gsl_function_struct gsl_function ;
>
> Can anybody please tell me how to translate this into Ada? I have no idea how to
> handle the void pointers.

Presuming that this is C's equivalent of a private type, and all allocation will 
be handled by the library, then the equivalent of void* is any convention-C 
access type. I'd probably write

type Void_Ptr is access all Integer;
pragma Convention (C, Void_Ptr);

type GSL_Function_Ptr is access
    function (X : Interfaces.C.Double; Params : Void_Ptr)
return Interfaces.C.Double;
pragma Convention (C, GSL_Function_Ptr);

type GSL_Function is record
    Func   : GSL_Function_Ptr;
    Params : Void_Ptr;
end record;
pragma Convention (C, GSL_Function);

-- 
Jeff Carter
"Pray that there's intelligent life somewhere up in
space, 'cause there's bugger all down here on earth."
Monty Python's Meaning of Life
61

Re: Interfaces.C questions

[Jeffrey R. Carter]

On 03/18/2017 04:46 PM, hreba wrote:
>
> struct gsl_function_struct
> {
>   double (* function) (double x, void * params);
>   void * params;
> };
> typedef struct gsl_function_struct gsl_function ;
>
> Can anybody please tell me how to translate this into Ada? I have no idea how to
> handle the void pointers.

Presuming that this is C's equivalent of a private type, and all allocation will 
be handled by the library, then the equivalent of void* is any convention-C 
access type. I'd probably write

type Void_Ptr is access all Integer;
pragma Convention (C, Void_Ptr);

type GSL_Function_Ptr is access
    function (X : Interfaces.C.Double; Params : Void_Ptr)
return Interfaces.C.Double;
pragma Convention (C, GSL_Function_Ptr);

type GSL_Function is record
    Func   : GSL_Function_Ptr;
    Params : Void_Ptr;
end record;
pragma Convention (C, GSL_Function);

-- 
Jeff Carter
"Pray that there's intelligent life somewhere up in
space, 'cause there's bugger all down here on earth."
Monty Python's Meaning of Life
61

Re: Interfaces.C questions

[Leo Brewin]

Hi Frank,

I'd be really interested to see a minimal working example once you've got it running.
I'd like to be able to use GSL in my own codes.

Cheers,
Leo

On Saturday, March 18, 2017 at 8:12:28 AM UTC+11, hreba wrote:
> These are my first steps with Interfaces.C:
> 
> ----------------------------------------------------------------------
> with Interfaces.C;
> 
> package GSL is
> 
>     package C renames Interfaces.C;
> 
>     type size_t is new C.int;
>     type Real_Function is access function (x: C.double) return C.double;
> 
>     function Bessel_J0 (x: C.double) return C.double;
> 
>     function Integration_QNG
>       (f: Real_Function;
>        a, b, epsabs, epsrel: C.double;
>        result, abserr: out C.double;
>        neval: out size_t)
>       return C.int;
> 
> private
> 
>     pragma Import (C, Bessel_J0,		"gsl_sf_bessel_J0");
>     pragma Import (C, Integration_QNG,	"gsl_integration_qng");
> 
> end GSL;
> ------------------------------------------------------------------------
> 
> No problem with function Bessel_J0. But Integration_QNG gets me:
> 
> gsl.ads:19:07: functions can only have "in" parameters.
> 
> The C prototype of this function is:
> 
> int gsl_integration_qng (const gsl function * f , double a , double b ,
> double epsabs , double epsrel , double * result , double * abserr , size 
> t * neval )
> 
> So my questions are:
> 
> 1. How do I translate C functions which return non-void and which 
> additionally use pointers for out parameters? Do I have to use pointers 
> in my Ada program?
> 
> 2. On my platform size_t is C.int. How can I define size_t in a 
> platform-independent way?
> 
> 3. The C function above needs a pointer to a function as parameter. Is 
> my translation to Ada correct?
> 
> -- 
> Frank Hrebabetzky		+49 / 6355 / 989 5070

Re: Interfaces.C questions

[Keith Thompson]

hreba <f_hreba@yahoo.com.br> writes:
[...]
> 2. On my platform size_t is C.int. How can I define size_t in a 
> platform-independent way?

No, it isn't.  C's size_t type is an unsigned type; int is a signed
type.  (As others have said, you should just use Interfaces.C.size_t.)

[...]

-- 
Keith Thompson (The_Other_Keith) kst-u@mib.org  <http://www.ghoti.net/~kst>
Working, but not speaking, for JetHead Development, Inc.
"We must do something.  This is something.  Therefore, we must do this."
    -- Antony Jay and Jonathan Lynn, "Yes Minister"

Re: Interfaces.C questions

[Keith Thompson]

hreba <f_hreba@yahoo.com.br> writes:
[...]
> struct gsl_function_struct
> {
>    double (* function) (double x, void * params);
>    void * params;
> };
> typedef struct gsl_function_struct gsl_function ;
>
> Can anybody please tell me how to translate this into Ada? I have no 
> idea how to handle the void pointers.

Ada's closest equivalent to C's void* is probably either
"System.Address" or "access unsigned_char".

-- 
Keith Thompson (The_Other_Keith) kst-u@mib.org  <http://www.ghoti.net/~kst>
Working, but not speaking, for JetHead Development, Inc.
"We must do something.  This is something.  Therefore, we must do this."
    -- Antony Jay and Jonathan Lynn, "Yes Minister"

Re: Interfaces.C questions

[Per Sandberg]

Why not use the compiler to generate the low-level bindings ??
	gcc -fdump-ada-spec

It works great takes 95% of the c headers, after generation its usually 
enough with some simple sed-scripts.

That way the binding generation could be 100% automated.

Have done that for some fairly large libraries 250 header-files that 
contains approx 18K ";" and 100K lines including blanks and comments.


/Per



Den 2017-03-17 kl. 22:12, skrev hreba:
> These are my first steps with Interfaces.C:
>
> ----------------------------------------------------------------------
> with Interfaces.C;
>
> package GSL is
>
>    package C renames Interfaces.C;
>
>    type size_t is new C.int;
>    type Real_Function is access function (x: C.double) return C.double;
>
>    function Bessel_J0 (x: C.double) return C.double;
>
>    function Integration_QNG
>      (f: Real_Function;
>       a, b, epsabs, epsrel: C.double;
>       result, abserr: out C.double;
>       neval: out size_t)
>      return C.int;
>
> private
>
>    pragma Import (C, Bessel_J0,        "gsl_sf_bessel_J0");
>    pragma Import (C, Integration_QNG,    "gsl_integration_qng");
>
> end GSL;
> ------------------------------------------------------------------------
>
> No problem with function Bessel_J0. But Integration_QNG gets me:
>
> gsl.ads:19:07: functions can only have "in" parameters.
>
> The C prototype of this function is:
>
> int gsl_integration_qng (const gsl function * f , double a , double b ,
> double epsabs , double epsrel , double * result , double * abserr , size
> t * neval )
>
> So my questions are:
>
> 1. How do I translate C functions which return non-void and which
> additionally use pointers for out parameters? Do I have to use pointers
> in my Ada program?
>
> 2. On my platform size_t is C.int. How can I define size_t in a
> platform-independent way?
>
> 3. The C function above needs a pointer to a function as parameter. Is
> my translation to Ada correct?
>

Re: Interfaces.C questions

[hreba]

On 03/19/2017 12:24 AM, Leo Brewin wrote:
> Hi Frank,
>
> I'd be really interested to see a minimal working example once you've got it running.
> I'd like to be able to use GSL in my own codes.
>
> Cheers,
> Leo
>

Ok, below follows my first working example, numerical quadrature. Any 
critics is welcome. Some remarks:

'void * params' in C can be a pointer to just anything, a number, an 
array, a record. The best solution probably would be  a generic package 
where the actual type is passed as parameter (see type Element in 
Interfaces.C.Pointers). The quadrature algorithm I chose makes no use of 
these parameters, so in my example I translate the type to 'access all 
Integer' and pass null as value.

As I am beginning to build a numerics library, I will now

  - make the package generic, with 2 type parameters, one for the reals
    (digits <>) and one for the parameters (private),
  - write wrappers so that the client needs no Interfaces.C, and that he
    can pass a function of
    'type Real_Function is access function (x: Real) return Real;'
    to the quadrature procedure instead of a record.

So here comes my example. The interface package is (no body):

-----------------------------------------------------------------------
with Interfaces.C;

package GSL is

    package C renames Interfaces.C;

    type Void_Ptr is access all Integer;
    type GSL_Function_Ptr is access
      function (x: C.double; params: Void_Ptr) return C.double;
    type GSL_Function is record
       func:	GSL_Function_Ptr;
       params:	Void_Ptr;
    end record;


    function Integration_QNG
      (f: access GSL_Function;
       a, b, epsabs, epsrel: C.double;
       result, abserr: out C.double;
       neval: out C.size_t)
      return C.int;

private

    pragma Import (C, Integration_QNG, "gsl_integration_qng");
    pragma Convention (C, Void_Ptr);
    pragma Convention (C, GSL_Function_Ptr);
    pragma Convention (C, GSL_Function);

end GSL;
-----------------------------------------------------------------------------

The main subprogram (client) is

-----------------------------------------------------------------------------
with Ada.Text_IO;	use Ada.Text_IO;
with GSL;
with Integ_Aux;

procedure Test_Integration
is
    use type GSL.C.double;
    a:		GSL.C.double;
    abserr:	GSL.C.double;
    neval:	GSL.C.size_t;
    res:		GSL.C.int;
    gslf:	aliased GSL.GSL_Function;

begin
    gslf.func:= Integ_Aux.Circle'Access;
    gslf.params:= null;
    res:= GSL.Integration_QNG
      (gslf'Access, 0.0, 1.0, 0.001, 0.001, a, abserr, neval);
    Put_Line("4*int_0^1 sqrt(1-x^2) dx = " & GSL.C.double'Image(4.0*a));
    Put_Line(GSL.C.size_t'Image(neval) & " function evaluations, " &
	      GSL.C.double'Image(abserr) & " abs. error");
end Test_Integration;
------------------------------------------------------------------------------
Because an access is passed to the function to be integrated it has to 
be in a separated package:
------------------------------------------------------------------------------
with GSL;

package Integ_Aux is
       function Circle (x: GSL.C.double; pars: GSL.Void_Ptr) return 
GSL.C.double;

private
    pragma Convention (C, Circle);
end Integ_Aux;
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
with Ada.Numerics.Generic_Elementary_Functions;
with GSL;

package body Integ_Aux is

    package Functions is new
      Ada.Numerics.Generic_Elementary_Functions (GSL.C.double);

    function Circle (x: GSL.C.double; pars: GSL.Void_Ptr) return 
GSL.C.double is
    use type GSL.C.double;
    begin return Functions.Sqrt(abs(1.0-x*x));
    end Circle;

end Integ_Aux;
--------------------------------------------------------------------------------
The project files of the interface package are
--------------------------------------------------------------------------------
-- External library "Gnu Scientific Library"

with "gslcblas";

Project GSL is

    type OS_Type is ("linux", "linux-gnu", "windows", "unknown");
    act_os: OS_Type:= external ("OSTYPE");
    -- act_os: OS_Type:= external ("OS_TYPE");

    For externally_built use "true";
    For library_dir use "/usr/lib";
    case act_os is
       when "linux"|"linux-gnu" => for library_dir use "/usr/lib";
       when "windows" => for library_dir use "/Lib/GSL";
       when "unknown" => for Source_Dirs use ("/");	-- just anything
    end case;
    For library_name use "gsl";
    For source_dirs use (); -- no sources.
    -- For library_kind use "static";
    -- if it is a static lib .a

    for library_kind use "dynamic";
    -- if it is an so.

end GSL;
-------------------------------------------------------------------------
-------------------------------------------------------------------------
-- External library "Gnu Scientific Library"


Project GSLCBLAS is

    type OS_Type is ("linux", "linux-gnu", "windows", "unknown");
    act_os: OS_Type:= external ("OSTYPE");
    -- act_os: OS_Type:= external ("OS_TYPE");

    For externally_built use "true";
    case act_os is
       when "linux"|"linux-gnu" => for library_dir use "/usr/lib";
       when "windows" => for library_dir use "/Lib/GSL";
       when "unknown" => for Source_Dirs use ("/");	-- just anything
    end case;
    For library_name use "gslcblas";
    For source_dirs use (); -- no sources.
    -- For library_kind use "static";
    -- if it is a static lib .a

    for library_kind use "dynamic";
    -- if it is an so.

end GSLCBLAS;
-----------------------------------------------------------------------------
I tried to make these projects platform independent (Linux and Windows 
so far); only tested on Linux so far. The environment variable OSTYPE 
must exist. If you don't want to do this, just type
for library_dir use "/usr/lib";
instead of the 'case' construct (on Linux).
Finally the project file for the main program:
-----------------------------------------------------------------------------
with "../../gsl.gpr";

project Test_Integration is

    for Source_Dirs use (".", "../../src"); -- test and interface sources
    for Object_Dir use "../obj";
    for Exec_Dir use ".";
    for Main use ("test_integration.adb");

    package Compiler is
       for Default_Switches ("ada") use ("-g", "-gnatf", "-gnat2012");
    end Compiler;

    package Linker is
       for Default_Switches ("ada") use ("-g");
    end Linker;

    package Builder is
       for Default_Switches ("ada") use ("-g");
    end Builder;

end Test_Integration;
------------------------------------------------------------------------------
The result is an approximation of the unit circle area, pi.

-- 
Frank Hrebabetzky		+49 / 6355 / 989 5070

Re: Interfaces.C questions

[hreba]

A crude, pure interface version for a GSL quadrature function works. Now 
I have unexpected difficulties with a wrapper, which is a generic package:

generic
    type Real is digits <>;
    type Parameters is private;
package GSL is
    type Real_Function is access function (x: Real) return Real;
    ...

The package body contains the following lines, everything on library level:

    type GSL_Function is record
       func:   access			-- this is line 21
	      function (x: C.double; params: Void_Ptr) return C.double;
       params: Void_Ptr;
    end record;
    pragma Convention (C, GSL_Function);

    real_func:	Real_Function;

    ----%<----------------------------------------------------------

    function func (x: C.double; params: Void_Ptr) return C.double is
    begin
       return C.double (real_func (Real(x)));
    end func;
    pragma Convention (C, func);		-- this is line 37

Later, within a procedure body:

       gslf:	aliased GSL_Function;
    begin
       gslf.func:= func'Access;		-- this is line 66
    ...

I get the following compiler messages and understand nothing:

gsl.adb:37:04: pragma "CONVENTION" requires separate spec and must come 
before body
gsl.adb:66:19: subprogram "func" has wrong convention
gsl.adb:66:19: does not match access to subprogram declared at line 21

  - Separate spec? How?
    Before body? All my other CONVENTION pragmas come after the
    subprogram body, without any problem.
  - No match? Where is the difference?

-- 
Frank Hrebabetzky		+49 / 6355 / 989 5070

Re: Interfaces.C questions

[Simon Wright]

hreba <f_hreba@yahoo.com.br> writes:

>    function func (x: C.double; params: Void_Ptr) return C.double is
>    begin
>       return C.double (real_func (Real(x)));
>    end func;
>    pragma Convention (C, func);		-- this is line 37

Try

   function func (x: C.double; params: Void_Ptr) return C.double;
   pragma Convention (C, func);
   function func (x: C.double; params: Void_Ptr) return C.double is
   begin
      return C.double (real_func (Real(x)));
   end func;

You have to have a spec, but there's nothing stopping it being declared
right before the body.

Of course, in most cases you'd prefer to do that earlier.

Re: Interfaces.C questions

[hreba]

On 03/19/2017 08:22 PM, Simon Wright wrote:
> hreba <f_hreba@yahoo.com.br> writes:
>
>>    function func (x: C.double; params: Void_Ptr) return C.double is
>>    begin
>>       return C.double (real_func (Real(x)));
>>    end func;
>>    pragma Convention (C, func);		-- this is line 37
>
> Try
>
>    function func (x: C.double; params: Void_Ptr) return C.double;
>    pragma Convention (C, func);
>    function func (x: C.double; params: Void_Ptr) return C.double is
>    begin
>       return C.double (real_func (Real(x)));
>    end func;
>
> You have to have a spec, but there's nothing stopping it being declared
> right before the body.
>
> Of course, in most cases you'd prefer to do that earlier.
>

Did that. Now I get:

gsl.adb:35:26: pragma "CONVENTION" argument must be in same declarative part

-- 
Frank Hrebabetzky		+49 / 6355 / 989 5070

Re: Interfaces.C questions

[Simon Wright]

hreba <f_hreba@yahoo.com.br> writes:

> On 03/19/2017 08:22 PM, Simon Wright wrote:
>> hreba <f_hreba@yahoo.com.br> writes:
>>
>>>    function func (x: C.double; params: Void_Ptr) return C.double is
>>>    begin
>>>       return C.double (real_func (Real(x)));
>>>    end func;
>>>    pragma Convention (C, func);		-- this is line 37
>>
>> Try
>>
>>    function func (x: C.double; params: Void_Ptr) return C.double;
>>    pragma Convention (C, func);
>>    function func (x: C.double; params: Void_Ptr) return C.double is
>>    begin
>>       return C.double (real_func (Real(x)));
>>    end func;
>>
>> You have to have a spec, but there's nothing stopping it being declared
>> right before the body.
>>
>> Of course, in most cases you'd prefer to do that earlier.
>>
>
> Did that. Now I get:
>
> gsl.adb:35:26: pragma "CONVENTION" argument must be in same declarative part

This compiles for me (with a warning, 'variable "real_func" is read but
never assigned'):

generic
   type Real is digits <>;
   type Parameters is private;
package GSL with Elaborate_Body is
   type Real_Function is access function (x: Real) return Real;
end Gsl;
with Interfaces.C;
package body Gsl is

   use Interfaces;

   type Void_Ptr is access all Integer;
   pragma Convention (C, Void_Ptr);

   type GSL_Function is record
      func:   access
	function (x: C.double; params: Void_Ptr) return C.double;
      params: Void_Ptr;
   end record;
   pragma Convention (C, GSL_Function);

   real_func:	Real_Function;

   function func (x: C.double; params: Void_Ptr) return C.Double;
   pragma Convention (C, func);

   function func (x: C.double; params: Void_Ptr) return C.double is
   begin
      return C.double (real_func (Real(x)));
   end func;

   procedure P is
      gslf:	aliased GSL_Function;
   begin
      gslf.func:= func'Access;
   end P;
end Gsl;

Re: Interfaces.C questions

[Leo Brewin]

Hi Frank,

Many thanks for sharing that code. I've wanted to play with GSL for a while but couldn't make sense of the C parameters and how to connect them back to Ada. Thanks again.

Cheers,
Leo

On Sunday, March 19, 2017 at 11:17:37 PM UTC+11, hreba wrote:
> On 03/19/2017 12:24 AM, Leo Brewin wrote:
> > Hi Frank,
> >
> > I'd be really interested to see a minimal working example once you've got it running.
> > I'd like to be able to use GSL in my own codes.
> >
> > Cheers,
> > Leo
> >
> 
> Ok, below follows my first working example, numerical quadrature. Any 
> critics is welcome. Some remarks:
> 
> 'void * params' in C can be a pointer to just anything, a number, an 
> array, a record. The best solution probably would be  a generic package 
> where the actual type is passed as parameter (see type Element in 
> Interfaces.C.Pointers). The quadrature algorithm I chose makes no use of 
> these parameters, so in my example I translate the type to 'access all 
> Integer' and pass null as value.
> 
> As I am beginning to build a numerics library, I will now
> 
>   - make the package generic, with 2 type parameters, one for the reals
>     (digits <>) and one for the parameters (private),
>   - write wrappers so that the client needs no Interfaces.C, and that he
>     can pass a function of
>     'type Real_Function is access function (x: Real) return Real;'
>     to the quadrature procedure instead of a record.
> 
> So here comes my example. The interface package is (no body):
> 
> -----------------------------------------------------------------------
> with Interfaces.C;
> 
> package GSL is
> 
>     package C renames Interfaces.C;
> 
>     type Void_Ptr is access all Integer;
>     type GSL_Function_Ptr is access
>       function (x: C.double; params: Void_Ptr) return C.double;
>     type GSL_Function is record
>        func:	GSL_Function_Ptr;
>        params:	Void_Ptr;
>     end record;
> 
> 
>     function Integration_QNG
>       (f: access GSL_Function;
>        a, b, epsabs, epsrel: C.double;
>        result, abserr: out C.double;
>        neval: out C.size_t)
>       return C.int;
> 
> private
> 
>     pragma Import (C, Integration_QNG, "gsl_integration_qng");
>     pragma Convention (C, Void_Ptr);
>     pragma Convention (C, GSL_Function_Ptr);
>     pragma Convention (C, GSL_Function);
> 
> end GSL;
> -----------------------------------------------------------------------------
> 
> The main subprogram (client) is
> 
> -----------------------------------------------------------------------------
> with Ada.Text_IO;	use Ada.Text_IO;
> with GSL;
> with Integ_Aux;
> 
> procedure Test_Integration
> is
>     use type GSL.C.double;
>     a:		GSL.C.double;
>     abserr:	GSL.C.double;
>     neval:	GSL.C.size_t;
>     res:		GSL.C.int;
>     gslf:	aliased GSL.GSL_Function;
> 
> begin
>     gslf.func:= Integ_Aux.Circle'Access;
>     gslf.params:= null;
>     res:= GSL.Integration_QNG
>       (gslf'Access, 0.0, 1.0, 0.001, 0.001, a, abserr, neval);
>     Put_Line("4*int_0^1 sqrt(1-x^2) dx = " & GSL.C.double'Image(4.0*a));
>     Put_Line(GSL.C.size_t'Image(neval) & " function evaluations, " &
> 	      GSL.C.double'Image(abserr) & " abs. error");
> end Test_Integration;
> ------------------------------------------------------------------------------
> Because an access is passed to the function to be integrated it has to 
> be in a separated package:
> ------------------------------------------------------------------------------
> with GSL;
> 
> package Integ_Aux is
>        function Circle (x: GSL.C.double; pars: GSL.Void_Ptr) return 
> GSL.C.double;
> 
> private
>     pragma Convention (C, Circle);
> end Integ_Aux;
> -------------------------------------------------------------------------------
> -------------------------------------------------------------------------------
> with Ada.Numerics.Generic_Elementary_Functions;
> with GSL;
> 
> package body Integ_Aux is
> 
>     package Functions is new
>       Ada.Numerics.Generic_Elementary_Functions (GSL.C.double);
> 
>     function Circle (x: GSL.C.double; pars: GSL.Void_Ptr) return 
> GSL.C.double is
>     use type GSL.C.double;
>     begin return Functions.Sqrt(abs(1.0-x*x));
>     end Circle;
> 
> end Integ_Aux;
> --------------------------------------------------------------------------------
> The project files of the interface package are
> --------------------------------------------------------------------------------
> -- External library "Gnu Scientific Library"
> 
> with "gslcblas";
> 
> Project GSL is
> 
>     type OS_Type is ("linux", "linux-gnu", "windows", "unknown");
>     act_os: OS_Type:= external ("OSTYPE");
>     -- act_os: OS_Type:= external ("OS_TYPE");
> 
>     For externally_built use "true";
>     For library_dir use "/usr/lib";
>     case act_os is
>        when "linux"|"linux-gnu" => for library_dir use "/usr/lib";
>        when "windows" => for library_dir use "/Lib/GSL";
>        when "unknown" => for Source_Dirs use ("/");	-- just anything
>     end case;
>     For library_name use "gsl";
>     For source_dirs use (); -- no sources.
>     -- For library_kind use "static";
>     -- if it is a static lib .a
> 
>     for library_kind use "dynamic";
>     -- if it is an so.
> 
> end GSL;
> -------------------------------------------------------------------------
> -------------------------------------------------------------------------
> -- External library "Gnu Scientific Library"
> 
> 
> Project GSLCBLAS is
> 
>     type OS_Type is ("linux", "linux-gnu", "windows", "unknown");
>     act_os: OS_Type:= external ("OSTYPE");
>     -- act_os: OS_Type:= external ("OS_TYPE");
> 
>     For externally_built use "true";
>     case act_os is
>        when "linux"|"linux-gnu" => for library_dir use "/usr/lib";
>        when "windows" => for library_dir use "/Lib/GSL";
>        when "unknown" => for Source_Dirs use ("/");	-- just anything
>     end case;
>     For library_name use "gslcblas";
>     For source_dirs use (); -- no sources.
>     -- For library_kind use "static";
>     -- if it is a static lib .a
> 
>     for library_kind use "dynamic";
>     -- if it is an so.
> 
> end GSLCBLAS;
> -----------------------------------------------------------------------------
> I tried to make these projects platform independent (Linux and Windows 
> so far); only tested on Linux so far. The environment variable OSTYPE 
> must exist. If you don't want to do this, just type
> for library_dir use "/usr/lib";
> instead of the 'case' construct (on Linux).
> Finally the project file for the main program:
> -----------------------------------------------------------------------------
> with "../../gsl.gpr";
> 
> project Test_Integration is
> 
>     for Source_Dirs use (".", "../../src"); -- test and interface sources
>     for Object_Dir use "../obj";
>     for Exec_Dir use ".";
>     for Main use ("test_integration.adb");
> 
>     package Compiler is
>        for Default_Switches ("ada") use ("-g", "-gnatf", "-gnat2012");
>     end Compiler;
> 
>     package Linker is
>        for Default_Switches ("ada") use ("-g");
>     end Linker;
> 
>     package Builder is
>        for Default_Switches ("ada") use ("-g");
>     end Builder;
> 
> end Test_Integration;
> ------------------------------------------------------------------------------
> The result is an approximation of the unit circle area, pi.
> 
> -- 
> Frank Hrebabetzky		+49 / 6355 / 989 5070

Re: Interfaces.C questions

[hreba]

On 03/20/2017 12:53 AM, Simon Wright wrote:
>
>    function func (x: C.double; params: Void_Ptr) return C.Double;
>    pragma Convention (C, func);
>
>    function func (x: C.double; params: Void_Ptr) return C.double is
>    begin
>       return C.double (real_func (Real(x)));
>    end func;
>

That's it. Apparently the correct sequence is declare - pragma - define. 
I didn't declare. Thanks for the hint, it works now.
-- 
Frank Hrebabetzky		+49 / 6355 / 989 5070

Re: Interfaces.C questions

[hreba]

My posting earlier was too fast: the program compiles, but terminates with a
STORAGE_ERROR : stack overflow or erroneous memory access.
This happens right at the call of gsl_integration_qng(), the function 
exported from the C library.

If somebody has an idea what could be wrong ...

My wrapper is package GSL:

----------------------------------------------------------------------
generic
    type Real is digits <>;
    type Parameters is private;
package GSL is

    gsl_Ex:	Exception;
    error_code:	Integer;	-- of the last operation

    type Real_Function is access function (x: Real) return Real;

    procedure Integration_QNG
      (f:			Real_Function;
       a, b, epsabs, epsrel:	Real;
       result, abserr:		out Real;
       neval:			out Natural);

end GSL;
-----------------------------------------------------------------------
-----------------------------------------------------------------------
with Interfaces.C;	use Interfaces;

package body GSL is

    type Void_Ptr is access all Parameters;
    pragma Convention (C, Void_Ptr);

    type GSL_Inner_Function is
      access function (x: C.double; params: Void_Ptr) return C.double;
    pragma Convention (C, GSL_Inner_Function);

    type GSL_Function is record
       func:	GSL_Inner_Function;
       params:	Void_Ptr;
    end record;

    real_func:	Real_Function;

    ---------------------------------------------------------------------
    --	Auxiliary Subprograms
    ---------------------------------------------------------------------

    function func (x: C.double; params: Void_Ptr) return C.double;
    pragma Convention (C, func);

    function func (x: C.double; params: Void_Ptr) return C.double is
    begin return C.double (real_func (Real(x)));
    end func;


    function gsl_integration_qng
      (f: access GSL_Function;
       a, b, epsabs, epsrel: C.double;
       result, abserr: out C.double;
       neval: out C.size_t)
      return C.int;
    pragma Import (C, gsl_integration_qng,	"gsl_integration_qng");


    ---------------------------------------------------------------------
    -- Exported Subprograms
    ---------------------------------------------------------------------

    procedure Integration_QNG
      (f: Real_Function;
       a, b, epsabs, epsrel:	Real;
       result, abserr:		out Real;
       neval:			out Natural)
    is
       use type C.int;
       gslf:	aliased GSL_Function;
       status:	C.int;
       res, ae:	C.double;
       ne:	C.size_t;
    begin
       real_func:= f;
       gslf.func:= func'Access;
       gslf.params:= null;
       status:= gsl_integration_qng    -- <-- STORAGE_ERROR occurs here
	(gslf'Access,
	 C.double(a), C.double(b), C.double(epsabs), C.double(epsrel),
	 res, ae, ne);
       if status /= 0 then
	 error_code:= Integer (status);
	 raise gsl_Ex with
	   "gsl_integration_qng() returns error code " & C.int'Image(status);
       end if;
       result:= Real(res);
       abserr:= Real(ae);
       neval:= Natural(ne);
    end Integration_QNG;

end GSL;
-------------------------------------------------------------------------

The test application is

-------------------------------------------------------------------------
with Ada.Text_IO;	use Ada.Text_IO;
with GSL;
with Integ_Aux;

procedure Test_Integration
is
    package GSL_Test is new GSL (Integ_Aux.Real, Integer);
    use type Integ_Aux.Real;
    a, abserr:	Integ_Aux.Real;
    neval:	Natural;
begin
    GSL_Test.Integration_QNG
      (Integ_Aux.Circle'Access, 0.0, 1.0, 0.001, 0.001, a, abserr, neval);
    Put_Line("4*int_0^1 sqrt(1-x^2) dx = " & Integ_Aux.Real'Image(4.0*a));
    Put_Line(Natural'Image(neval) & " function evaluations, " &
	      Integ_Aux.Real'Image(abserr) & " abs. error");
end Test_Integration;
---------------------------------------------------------------------------

which imports also

---------------------------------------------------------------------------
with Interfaces;

package Integ_Aux is

    type Real is new Interfaces.IEEE_Float_32;
    function Circle (x: Real) return Real;

end Integ_Aux;
---------------------------------------------------------------------------
---------------------------------------------------------------------------
with Ada.Numerics.Generic_Elementary_Functions;

package body Integ_Aux is

    package Functions is new
      Ada.Numerics.Generic_Elementary_Functions (Real);

    function Circle (x: Real) return Real is
    begin return Functions.Sqrt(abs(1.0-x*x));
    end Circle;

end Integ_Aux;
------------------------------------------------------------------------------

-- 
Frank Hrebabetzky		+49 / 6355 / 989 5070

Re: Interfaces.C questions

[Michael B.]

On 17.03.2017 23:24, Dmitry A. Kazakov wrote:
> P.S. For convention C assume this:
>
> 1. out T, in out T, access T are equivalent
>
> 2. in T and access T are equivalent when T is non-scalar (you can pass
> int, array, or record, the compiler will sort that out)
>

Is this GNAT specific or true for all Ada compilers?

Re: Interfaces.C questions

[Dmitry A. Kazakov]

On 2017-03-21 22:08, Michael B. wrote:
> On 17.03.2017 23:24, Dmitry A. Kazakov wrote:
>> P.S. For convention C assume this:
>>
>> 1. out T, in out T, access T are equivalent
>>
>> 2. in T and access T are equivalent when T is non-scalar (you can pass
>> int, array, or record, the compiler will sort that out)
>>
>
> Is this GNAT specific or true for all Ada compilers?

AFAIK it is not GNAT specific.

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de

Re: Interfaces.C questions

[Simon Wright]

"Michael B." <michaelb@example.com> writes:

> On 17.03.2017 23:24, Dmitry A. Kazakov wrote:
>> P.S. For convention C assume this:
>>
>> 1. out T, in out T, access T are equivalent
>>
>> 2. in T and access T are equivalent when T is non-scalar (you can pass
>> int, array, or record, the compiler will sort that out)
>>
>
> Is this GNAT specific or true for all Ada compilers?

See ARM B.3(63)[1]ff for the ARM on this subject.

[1] http://www.ada-auth.org/standards/rm12_w_tc1/html/RM-B-3.html#p63

Re: Interfaces.C questions

[hreba]

On 03/20/2017 03:04 PM, hreba wrote:
> My posting earlier was too fast: the program compiles, but terminates
> with a
> STORAGE_ERROR : stack overflow or erroneous memory access.
> This happens right at the call of gsl_integration_qng(), the function
> exported from the C library.
>
> If somebody has an idea what could be wrong ...
>
> My wrapper is package GSL:
>
> ----------------------------------------------------------------------
> generic
>    type Real is digits <>;
>    type Parameters is private;
> package GSL is
>
>    gsl_Ex:    Exception;
>    error_code:    Integer;    -- of the last operation
>
>    type Real_Function is access function (x: Real) return Real;
>
>    procedure Integration_QNG
>      (f:            Real_Function;
>       a, b, epsabs, epsrel:    Real;
>       result, abserr:        out Real;
>       neval:            out Natural);
>
> end GSL;
> -----------------------------------------------------------------------
> -----------------------------------------------------------------------
> with Interfaces.C;    use Interfaces;
>
> package body GSL is
>
>    type Void_Ptr is access all Parameters;
>    pragma Convention (C, Void_Ptr);
>
>    type GSL_Inner_Function is
>      access function (x: C.double; params: Void_Ptr) return C.double;
>    pragma Convention (C, GSL_Inner_Function);
>
>    type GSL_Function is record
>       func:    GSL_Inner_Function;
>       params:    Void_Ptr;
>    end record;
>
>    real_func:    Real_Function;
>
>    ---------------------------------------------------------------------
>    --    Auxiliary Subprograms
>    ---------------------------------------------------------------------
>
>    function func (x: C.double; params: Void_Ptr) return C.double;
>    pragma Convention (C, func);
>
>    function func (x: C.double; params: Void_Ptr) return C.double is
>    begin return C.double (real_func (Real(x)));
>    end func;
>
>
>    function gsl_integration_qng
>      (f: access GSL_Function;
>       a, b, epsabs, epsrel: C.double;
>       result, abserr: out C.double;
>       neval: out C.size_t)
>      return C.int;
>    pragma Import (C, gsl_integration_qng,    "gsl_integration_qng");
>
>
>    ---------------------------------------------------------------------
>    -- Exported Subprograms
>    ---------------------------------------------------------------------
>
>    procedure Integration_QNG
>      (f: Real_Function;
>       a, b, epsabs, epsrel:    Real;
>       result, abserr:        out Real;
>       neval:            out Natural)
>    is
>       use type C.int;
>       gslf:    aliased GSL_Function;
>       status:    C.int;
>       res, ae:    C.double;
>       ne:    C.size_t;
>    begin
>       real_func:= f;
>       gslf.func:= func'Access;
>       gslf.params:= null;
>       status:= gsl_integration_qng    -- <-- STORAGE_ERROR occurs here
>     (gslf'Access,
>      C.double(a), C.double(b), C.double(epsabs), C.double(epsrel),
>      res, ae, ne);
>       if status /= 0 then
>      error_code:= Integer (status);
>      raise gsl_Ex with
>        "gsl_integration_qng() returns error code " & C.int'Image(status);
>       end if;
>       result:= Real(res);
>       abserr:= Real(ae);
>       neval:= Natural(ne);
>    end Integration_QNG;
>
> end GSL;
> -------------------------------------------------------------------------
>
> The test application is
>
> -------------------------------------------------------------------------
> with Ada.Text_IO;    use Ada.Text_IO;
> with GSL;
> with Integ_Aux;
>
> procedure Test_Integration
> is
>    package GSL_Test is new GSL (Integ_Aux.Real, Integer);
>    use type Integ_Aux.Real;
>    a, abserr:    Integ_Aux.Real;
>    neval:    Natural;
> begin
>    GSL_Test.Integration_QNG
>      (Integ_Aux.Circle'Access, 0.0, 1.0, 0.001, 0.001, a, abserr, neval);
>    Put_Line("4*int_0^1 sqrt(1-x^2) dx = " & Integ_Aux.Real'Image(4.0*a));
>    Put_Line(Natural'Image(neval) & " function evaluations, " &
>           Integ_Aux.Real'Image(abserr) & " abs. error");
> end Test_Integration;
> ---------------------------------------------------------------------------
>
> which imports also
>
> ---------------------------------------------------------------------------
> with Interfaces;
>
> package Integ_Aux is
>
>    type Real is new Interfaces.IEEE_Float_32;
>    function Circle (x: Real) return Real;
>
> end Integ_Aux;
> ---------------------------------------------------------------------------
> ---------------------------------------------------------------------------
> with Ada.Numerics.Generic_Elementary_Functions;
>
> package body Integ_Aux is
>
>    package Functions is new
>      Ada.Numerics.Generic_Elementary_Functions (Real);
>
>    function Circle (x: Real) return Real is
>    begin return Functions.Sqrt(abs(1.0-x*x));
>    end Circle;
>
> end Integ_Aux;
> ------------------------------------------------------------------------------
>
>
I experimented a little. When I delete the formal type parameter "Real" 
from the "generic" specification of package GSL, and declare a subtype 
"Real" inside it, then it works as expected.

I wrote a simpler example too, where just a function (gsl_bessl_j0) is 
called from the C library, and no function reference is passed as a 
parameter. This worked in the non-generic as well in the generic version.

If somebody could have a look ...

-- 
Frank Hrebabetzky		+49 / 6355 / 989 5070

Re: Interfaces.C questions

[Randy Brukardt]

"Simon Wright" <simon@pushface.org> wrote in message 
news:lyvar2co6i.fsf@pushface.org...
> "Michael B." <michaelb@example.com> writes:
>
>> On 17.03.2017 23:24, Dmitry A. Kazakov wrote:
>>> P.S. For convention C assume this:
>>>
>>> 1. out T, in out T, access T are equivalent
>>>
>>> 2. in T and access T are equivalent when T is non-scalar (you can pass
>>> int, array, or record, the compiler will sort that out)
>>>
>>
>> Is this GNAT specific or true for all Ada compilers?
>
> See ARM B.3(63)[1]ff for the ARM on this subject.
>
> [1] http://www.ada-auth.org/standards/rm12_w_tc1/html/RM-B-3.html#p63

Keep in mind that this is Implementation Advice, not a requirement. 
Implementations are supposed to document variations from IA, but how that's 
done (and how useful it is) varies wildly. Our experience with Claw says 
that implementors try to follow it pretty closely. The only deviations that 
wehad in Janus/Ada was in cases where the advice made no sense (and those 
have been cleaned up in the years since).

                                   Randy.