Re: Interfaces.C + generics: stack overflow

["Randy Brukardt" <randy@rrsoftware.com>]

I don't see anything obviously wrong with your code (Janus/Ada can't compile 
it for various reasons, including that it doesn't yet support "in out" 
parameters on functions, so I didn't learn much from that attempt.)

What I would suggest is moving all of the actual C interface stuff out of 
the generic, making the generic part of the think binding rather than trying 
to do it all in one. That's likely to get rid of any bugs and make the code 
more portable.
The body of the generic would use type conversions (and if necessary, 
Unchecked_Conversion) to match up the formal types with the types of the 
thin binding. As I noted yesterday, that would make it a lot more portable 
to compilers that support some form of code sharing (which can't, in 
general, support C interfacing in a generic body).

Hope the above gives you some suggestions to try.

                 Randy.


"hreba" <f_hreba@yahoo.com.br> wrote in message 
news:ejkigvFlkjbU1@mid.individual.net...
> On 03/23/2017 09:03 PM, Randy Brukardt wrote:
>> I agree with Jeff, there's not enough detail here to even see if there is 
>> a
>> bug or your mistake. We need to know how/where the generic is 
>> instantiated,
>> where/how the access-to-function value is created, and probably more.
>>
> The complete code follows below. The suggestion from Jeffrey is already 
> realized. The packages are:
>  - GSL wrapper for the C library
>  - Test_Integration main program, instantiates GSL
>  - Integ_Aux defines the function to be handed over
>
>> But let me say that the rules for access-to-subprogram types are 
>> different
>> inside of generics than they are in normal packages, in order to allow 
>> for
>> the possibility of generic sharing. That ought to manifest as 
>> compile-time
>> errors and/or the raising of Program_Error, so it seems that there might 
>> be
>> a compiler bug in your code. But to find that, one needs to see the whole
>> thing, not just a little corner.
>>
>> If you really want to write portable interfacing code, you would not use 
>> any
>> generics in the raw interface. (Have the generics call non-generic 
>> interface
>> code with appropriate type conversions.) Janus/Ada doesn't allow any
>> convention C stuff in generic units, because it is incompatible with the
>> extra dope needed to implemented universal generic sharing. I'd expect
>> something similar to happen for any implementation that supports almost 
>> any
>> form of generic sharing. (If you only care about GNAT, do what ever you
>> want.)
>>
> I am not writing this program only for its result, but also as an exercise 
> in Ada programming. So I want to do it the right way. So far I know 
> basically the book from John Barnes, where this topic is not treated, so 
> thanks for your comments, I will modify my program accordingly.
>
> ---------------------------------------------------------------------------
> generic
>    type Real is digits <>;
>    type Parameters is private; -- for future use
> 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: in out 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: 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,
>          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;
> ------------------------------------------------------------------------------
> 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;
> ------------------------------------------------------------------------------
> 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
>