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