Re: Interfaces.C questions

[hreba <f_hreba@yahoo.com.br>]

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