From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Mark H Weaver Newsgroups: gmane.lisp.guile.bugs Subject: bug#18592: FFI should have portable access to =?UTF-8?Q?=E2=80=98errno=E2=80=99?= Date: Thu, 18 Feb 2016 08:30:19 -0500 Message-ID: <871t8af8no.fsf@netris.org> References: <87fvf8oocf.fsf@ft.bewatermyfriend.org> <87h9vmy0zw.fsf@gnu.org> <87twzgeh3c.fsf@yeeloong.lan> <87r3uko4c9.fsf@gnu.org> <1451565229.3594.59.camel@Renee-desktop.suse> <1451909046.3594.135.camel@Renee-desktop.suse> <8760z9gw7o.fsf@netris.org> <1451934872.3594.150.camel@Renee-desktop.suse> <20160105074924.GA23165@tuxteam.de> <1451983123.3594.156.camel@Renee-desktop.suse> <87vb78jc86.fsf@netris.org> <1452021701.3594.160.camel@Renee-desktop.suse> <1455783943.3838.16.camel@Renee-desktop.suse> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1455802285 24071 80.91.229.3 (18 Feb 2016 13:31:25 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Thu, 18 Feb 2016 13:31:25 +0000 (UTC) Cc: 18592@debbugs.gnu.org To: Nala Ginrut Original-X-From: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Thu Feb 18 14:31:14 2016 Return-path: Envelope-to: guile-bugs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1aWOfo-0000pV-Iw for guile-bugs@m.gmane.org; Thu, 18 Feb 2016 14:31:12 +0100 Original-Received: from localhost ([::1]:41322 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aWOfo-0002F9-2Y for guile-bugs@m.gmane.org; Thu, 18 Feb 2016 08:31:12 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:45045) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aWOfi-0002Et-Je for bug-guile@gnu.org; Thu, 18 Feb 2016 08:31:08 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1aWOfe-0001OV-Dl for bug-guile@gnu.org; Thu, 18 Feb 2016 08:31:06 -0500 Original-Received: from debbugs.gnu.org ([208.118.235.43]:34924) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aWOfe-0001OQ-9z for bug-guile@gnu.org; Thu, 18 Feb 2016 08:31:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84) (envelope-from ) id 1aWOfe-0001BP-0w for bug-guile@gnu.org; Thu, 18 Feb 2016 08:31:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Mark H Weaver Original-Sender: "Debbugs-submit" Resent-CC: bug-guile@gnu.org Resent-Date: Thu, 18 Feb 2016 13:31:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 18592 X-GNU-PR-Package: guile X-GNU-PR-Keywords: Original-Received: via spool by 18592-submit@debbugs.gnu.org id=B18592.14558022354511 (code B ref 18592); Thu, 18 Feb 2016 13:31:01 +0000 Original-Received: (at 18592) by debbugs.gnu.org; 18 Feb 2016 13:30:35 +0000 Original-Received: from localhost ([127.0.0.1]:60284 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84) (envelope-from ) id 1aWOfC-0001Ah-VG for submit@debbugs.gnu.org; Thu, 18 Feb 2016 08:30:35 -0500 Original-Received: from world.peace.net ([50.252.239.5]:44922 ident=hope1) by debbugs.gnu.org with esmtp (Exim 4.84) (envelope-from ) id 1aWOfB-0001AZ-Bj for 18592@debbugs.gnu.org; Thu, 18 Feb 2016 08:30:33 -0500 Original-Received: from [10.1.10.78] (helo=jojen) by world.peace.net with esmtpsa (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.72) (envelope-from ) id 1aWOez-0002Xi-HB; Thu, 18 Feb 2016 08:30:21 -0500 In-Reply-To: <1455783943.3838.16.camel@Renee-desktop.suse> (Nala Ginrut's message of "Thu, 18 Feb 2016 16:25:43 +0800") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.0.91 (gnu/linux) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-guile@gnu.org List-Id: "Bug reports for GUILE, GNU's Ubiquitous Extension Language" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Original-Sender: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.bugs:7963 Archived-At: --=-=-= Content-Type: text/plain Nala Ginrut writes: > Is there still any problem with the previous patch? Yes. I'm sorry, but we were failing to communicate and I did not have time to continue trying, so instead I made my own patch, attached below. Can you try this patch, and tell me if it does what you need? Thanks, Mark --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-PRELIMINARY-Add-support-for-errno-to-Dynamic-FFI.patch Content-Description: [PATCH] PRELIMINARY: Add support for errno to Dynamic FFI >From 17a3ee8c255e06ea7ee805401c94853fb48cbf12 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 5 Jan 2016 16:30:41 -0500 Subject: [PATCH] PRELIMINARY: Add support for errno to Dynamic FFI. --- doc/ref/api-foreign.texi | 15 +++++--- libguile/foreign.c | 89 ++++++++++++++++++++++++++++++++++++++---------- libguile/foreign.h | 4 ++- 3 files changed, 85 insertions(+), 23 deletions(-) diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi index c2c49ec..25eaabf 100644 --- a/doc/ref/api-foreign.texi +++ b/doc/ref/api-foreign.texi @@ -1,7 +1,7 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2008, -@c 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc. +@c Copyright (C) 1996, 1997, 2000-2004, 2007-2014, 2016 +@c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @node Foreign Function Interface @@ -813,8 +813,11 @@ tightly packed structs and unions by hand. See the code for Of course, the land of C is not all nouns and no verbs: there are functions too, and Guile allows you to call them. -@deffn {Scheme Procedure} pointer->procedure return_type func_ptr arg_types -@deffnx {C Procedure} scm_pointer_to_procedure (return_type, func_ptr, arg_types) +@deffn {Scheme Procedure} pointer->procedure return_type func_ptr arg_types @ + [#:return-errno?=#f] +@deffnx {C Function} scm_pointer_to_procedure (return_type, func_ptr, arg_types) +@deffnx {C Function} scm_pointer_to_procedure_with_errno (return_type, func_ptr, arg_types) + Make a foreign function. Given the foreign void pointer @var{func_ptr}, its argument and @@ -825,6 +828,10 @@ and return appropriate values. @var{arg_types} should be a list of foreign types. @code{return_type} should be a foreign type. @xref{Foreign Types}, for more information on foreign types. + +If @var{return-errno?} is true, or when calling +@code{scm_pointer_to_procedure_with_errno}, the returned procedure will +return two values, with @code{errno} as the second value. @end deffn Here is a better definition of @code{(math bessel)}: diff --git a/libguile/foreign.c b/libguile/foreign.c index 29cfc73..f770100 100644 --- a/libguile/foreign.c +++ b/libguile/foreign.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2010-2015 Free Software Foundation, Inc. +/* Copyright (C) 2010-2016 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -26,6 +26,7 @@ #include #include #include +#include #include "libguile/_scm.h" #include "libguile/bytevectors.h" @@ -85,7 +86,7 @@ null_pointer_error (const char *func_name) } -static SCM cif_to_procedure (SCM cif, SCM func_ptr); +static SCM cif_to_procedure (SCM cif, SCM func_ptr, SCM return_errno); static SCM pointer_weak_refs = SCM_BOOL_F; @@ -753,24 +754,58 @@ make_cif (SCM return_type, SCM arg_types, const char *caller) } #undef FUNC_NAME -SCM_DEFINE (scm_pointer_to_procedure, "pointer->procedure", 3, 0, 0, - (SCM return_type, SCM func_ptr, SCM arg_types), +static SCM +pointer_to_procedure (SCM return_type, SCM func_ptr, SCM arg_types, + SCM return_errno) +#define FUNC_NAME "pointer->procedure" +{ + ffi_cif *cif; + + SCM_VALIDATE_POINTER (2, func_ptr); + + cif = make_cif (return_type, arg_types, FUNC_NAME); + + return cif_to_procedure (scm_from_pointer (cif, NULL), func_ptr, + return_errno); +} +#undef FUNC_NAME + +SCM +scm_pointer_to_procedure (SCM return_type, SCM func_ptr, SCM arg_types) +{ + return pointer_to_procedure (return_type, func_ptr, arg_types, SCM_BOOL_F); +} + +SCM +scm_pointer_to_procedure_with_errno (SCM return_type, SCM func_ptr, + SCM arg_types) +{ + return pointer_to_procedure (return_type, func_ptr, arg_types, SCM_BOOL_T); +} + +SCM_KEYWORD (k_return_errno, "return-errno?"); + +SCM_DEFINE (scm_i_pointer_to_procedure, "pointer->procedure", 3, 0, 1, + (SCM return_type, SCM func_ptr, SCM arg_types, SCM keyword_args), "Make a foreign function.\n\n" "Given the foreign void pointer @var{func_ptr}, its argument and\n" "return types @var{arg_types} and @var{return_type}, return a\n" "procedure that will pass arguments to the foreign function\n" "and return appropriate values.\n\n" "@var{arg_types} should be a list of foreign types.\n" - "@code{return_type} should be a foreign type.") -#define FUNC_NAME s_scm_pointer_to_procedure + "@code{return_type} should be a foreign type.\n" + "If the @code{#:return-errno?} keyword argument is provided and\n" + "its value is true, then the returned procedure will return two\n" + "values, with @code{errno} as the second value.") +#define FUNC_NAME "pointer->procedure" { - ffi_cif *cif; + SCM return_errno = SCM_BOOL_F; - SCM_VALIDATE_POINTER (2, func_ptr); - - cif = make_cif (return_type, arg_types, FUNC_NAME); + scm_c_bind_keyword_arguments (FUNC_NAME, keyword_args, 0, + k_return_errno, &return_errno, + SCM_UNDEFINED); - return cif_to_procedure (scm_from_pointer (cif, NULL), func_ptr); + return pointer_to_procedure (return_type, func_ptr, arg_types, return_errno); } #undef FUNC_NAME @@ -940,16 +975,20 @@ get_objcode_trampoline (unsigned int nargs) } static SCM -cif_to_procedure (SCM cif, SCM func_ptr) +cif_to_procedure (SCM cif, SCM func_ptr, SCM return_errno) { ffi_cif *c_cif; SCM objcode, table, ret; c_cif = (ffi_cif *) SCM_POINTER_VALUE (cif); objcode = get_objcode_trampoline (c_cif->nargs); - + + /* Convert 'return_errno' to a simple boolean, to avoid retaining + references to non-boolean objects. */ + return_errno = scm_from_bool (scm_is_true (return_errno)); + table = scm_c_make_vector (2, SCM_UNDEFINED); - SCM_SIMPLE_VECTOR_SET (table, 0, scm_cons (cif, func_ptr)); + SCM_SIMPLE_VECTOR_SET (table, 0, scm_cons2 (cif, func_ptr, return_errno)); SCM_SIMPLE_VECTOR_SET (table, 1, SCM_BOOL_F); /* name */ ret = scm_make_program (objcode, table, SCM_BOOL_F); @@ -1116,9 +1155,11 @@ scm_i_foreign_call (SCM foreign, const SCM *argv) unsigned i; size_t arg_size; scm_t_ptrdiff off; + SCM return_errno; cif = SCM_POINTER_VALUE (SCM_CAR (foreign)); - func = SCM_POINTER_VALUE (SCM_CDR (foreign)); + func = SCM_POINTER_VALUE (SCM_CADR (foreign)); + return_errno = SCM_CDDR (foreign); /* Argument pointers. */ args = alloca (sizeof (void *) * cif->nargs); @@ -1153,10 +1194,22 @@ scm_i_foreign_call (SCM foreign, const SCM *argv) rvalue = (void *) ROUND_UP ((scm_t_uintptr) data + off, max (sizeof (void *), cif->rtype->alignment)); - /* off we go! */ - ffi_call (cif, func, rvalue, args); + if (scm_is_true (return_errno)) + { + int errno_save; + + errno = 0; + ffi_call (cif, func, rvalue, args); + errno_save = errno; - return pack (cif->rtype, rvalue, 1); + return scm_values (scm_list_2 (pack (cif->rtype, rvalue, 1), + scm_from_int (errno_save))); + } + else + { + ffi_call (cif, func, rvalue, args); + return pack (cif->rtype, rvalue, 1); + } } diff --git a/libguile/foreign.h b/libguile/foreign.h index 41c0b65..f8a176b 100644 --- a/libguile/foreign.h +++ b/libguile/foreign.h @@ -1,7 +1,7 @@ #ifndef SCM_FOREIGN_H #define SCM_FOREIGN_H -/* Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc. +/* Copyright (C) 2010, 2011, 2012, 2016 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -94,6 +94,8 @@ SCM_INTERNAL SCM scm_pointer_to_string (SCM pointer, SCM length, SCM encoding); SCM_API SCM scm_pointer_to_procedure (SCM return_type, SCM func_ptr, SCM arg_types); +SCM_API SCM scm_pointer_to_procedure_with_errno (SCM return_type, SCM func_ptr, + SCM arg_types); SCM_API SCM scm_procedure_to_pointer (SCM return_type, SCM func_ptr, SCM arg_types); SCM_INTERNAL SCM scm_i_foreign_call (SCM foreign, const SCM *argv); -- 2.6.3 --=-=-=--