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.unit0.net!fu-berlin.de!uni-berlin.de!individual.net!not-for-mail From: hreba Newsgroups: comp.lang.ada Subject: Re: Interfaces.C + generics: stack overflow Date: Fri, 24 Mar 2017 13:42:08 +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 kCfxto0TfI7EhPGxQ5Y5IAOGf11Yo2ETjLNPYn3rZXKpmQfQut Cancel-Lock: sha1:Cle17t6SOYJwZU2sypuOzjoWsac= 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:46447 Date: 2017-03-24T13:42:08+01:00 List-Id: 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