From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,FREEMAIL_FROM autolearn=unavailable autolearn_force=no version=3.4.4 Path: eternal-september.org!reader01.eternal-september.org!reader02.eternal-september.org!news.eternal-september.org!news.eternal-september.org!feeder.eternal-september.org!news.swapon.de!fu-berlin.de!uni-berlin.de!individual.net!not-for-mail From: hreba Newsgroups: comp.lang.ada Subject: Re: Interfaces.C questions Date: Wed, 22 Mar 2017 12:21:17 +0100 Message-ID: References: Mime-Version: 1.0 Content-Type: text/plain; charset=windows-1252; format=flowed Content-Transfer-Encoding: 7bit X-Trace: individual.net 6ae0PT5YpRiO56Zb7yOhhgppWy2MsUmXFhuWSMuHV7R1KhEF3j Cancel-Lock: sha1:T3xUAHBotsy+Rfh3xed6+nbHXU8= User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:45.0) Gecko/20100101 Thunderbird/45.5.1 In-Reply-To: Xref: news.eternal-september.org comp.lang.ada:46438 Date: 2017-03-22T12:21:17+01:00 List-Id: 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