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 questions Date: Mon, 20 Mar 2017 15:04:03 +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 5EaloiqSJyxcn3iiQBvB+gclpLz/+JxOQRsn9lBoSelpnksrAf Cancel-Lock: sha1:m5qj+jKyonHF+IQt873Q5Cz5ptk= 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:46432 Date: 2017-03-20T15:04:03+01:00 List-Id: 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