bug#18592: FFI should have portable access to ‘errno’

bug#18592: FFI should have portable access to ‘errno’

[Frank Terbeck]

Hello Guile Maintainers!

When accessing POSIX functions from a system's libc via Guile's dynamic
FFI, you commonly want to access the ‘errno’ variable to be able to
produce useful diagnostic messages.

Currently there's no such access built-in.

Mark Weaver on IRC thought it would be a good idea to add portable
access to the contents of ‘errno’ (however it's actually implemented) to
Guile's FFI. And now the idea has entered the bug tracker. :)


Regards, Frank

-- 
In protocol design, perfection has been reached not when there is
nothing left to add, but when there is nothing left to take away.
                                                  -- RFC 1925

bug#18592: FFI should have portable access to ‘errno’

[Mark H Weaver]

Frank Terbeck <ft@bewatermyfriend.org> writes:

> When accessing POSIX functions from a system's libc via Guile's dynamic
> FFI, you commonly want to access the ‘errno’ variable to be able to
> produce useful diagnostic messages.
>
> Currently there's no such access built-in.
>
> Mark Weaver on IRC thought it would be a good idea to add portable
> access to the contents of ‘errno’ (however it's actually implemented) to
> Guile's FFI. And now the idea has entered the bug tracker. :)

Indeed, thanks for filing this ticket.

I see a problem with this idea: something (e.g. a system async) might
change 'errno' before the Scheme code fetches the 'errno' value.

     Mark

bug#18592: FFI should have portable access to ‘errno’

[Frank Terbeck]

Mark H. Weaver wrote:
> Frank Terbeck <ft@bewatermyfriend.org> writes:
[...]
>> Mark Weaver on IRC thought it would be a good idea to add portable
>> access to the contents of ‘errno’ (however it's actually implemented) to
>> Guile's FFI. And now the idea has entered the bug tracker. :)
>
> Indeed, thanks for filing this ticket.
>
> I see a problem with this idea: something (e.g. a system async) might
> change 'errno' before the Scheme code fetches the 'errno' value.

Yes. Ludovic hinted at the use of ‘call-with-blocked-asyncs’ to avoid
this. To deal with that, I wrote a macro for guile-termios¹:

(define-syntax-rule (call-with-errno (errno exp) fail0 fail1 ...)
  (let-values (((failed? errno) (call-with-blocked-asyncs
                                 (lambda ()
                                   (let* ((f? (termios-failure? exp))
                                          (err (if f? (get-errno) 0)))
                                     (values f? err))))))
    (if failed?
        (begin fail0 fail1 ...)
        #t)))

That seems to work fine, unless I'm missing something.


Regards, Frank

 ¹ https://github.com/ft/guile-termios

bug#18592: FFI should have portable access to ‘errno’

[Mark H Weaver]

Frank Terbeck <ft@bewatermyfriend.org> writes:

> Mark H. Weaver wrote:
>> Frank Terbeck <ft@bewatermyfriend.org> writes:
> [...]
>>> Mark Weaver on IRC thought it would be a good idea to add portable
>>> access to the contents of ‘errno’ (however it's actually implemented) to
>>> Guile's FFI. And now the idea has entered the bug tracker. :)
>>
>> Indeed, thanks for filing this ticket.
>>
>> I see a problem with this idea: something (e.g. a system async) might
>> change 'errno' before the Scheme code fetches the 'errno' value.
>
> Yes. Ludovic hinted at the use of ‘call-with-blocked-asyncs’ to avoid
> this. To deal with that, I wrote a macro for guile-termios¹:
>
> (define-syntax-rule (call-with-errno (errno exp) fail0 fail1 ...)
>   (let-values (((failed? errno) (call-with-blocked-asyncs
>                                  (lambda ()
>                                    (let* ((f? (termios-failure? exp))
>                                           (err (if f? (get-errno) 0)))
>                                      (values f? err))))))
>     (if failed?
>         (begin fail0 fail1 ...)
>         #t)))
>
> That seems to work fine, unless I'm missing something.

I looked at guile-termios, and I can see that you've done about as good
a job as could be expected from pure Guile Scheme code today, but even
so, it's neither portable nor future-proof, and might not even work
reliably today.  One potential problem is that memory allocation might
modify 'errno', and in Guile 2.2 even calling a Scheme procedure can
cause memory allocation if the stack needs to be expanded.

With current versions of Guile, I see no good way to check 'errno' using
the Dynamic FFI.  I think the only proper solution today is to write a C
extension that wraps each library function that might set 'errno', and
to have those wrappers check 'errno' immediately after the wrapped
function returns, without using any libguile functions in between.

I intend to have a better solution for this in Guile 2.0.12.

    Regards,
      Mark

bug#18592: FFI should have portable access to ‘errno’

[Chaos Eternal]

Proposals to solve this bug:

Proposal 1.

Adding a keyword argument to pointer->procedure, if set to true, the
generated wrapper will check 'errno' immediately after ffi_call and
return the errno as second value.

the proposed pointer->procedure maybe like this:
pointer->procedure return_type func_ptr arg_types #:return-errno

Proposal 2.

let pointer->procedure check return_type, if it is a list:
(func_return_type, 'errno)
then return multiple values, as errno be second value.

Proposal 3.

introduce another procedure "pointers->procedure", which will pack
multiple function pointer into one procedure, in this procedure, the
packed functions will be called in sequence, and their return value
will be returned as multiple values.

the interface would be like this:
pointers->procedure (list-of-return-type) (list-of-pointers) (list-of arg-defs)

also, we need a simple c-function deref-pointer-to-int, which will
de-reference a pointer and return it's int value.

using above tools, a proper system call with errno be returned could
be like this:

((pointers->procedure
    (list int int)
    (list pointer-of-inotify-add-watch pointer-of-deref-pointer-to-int)
    (list (list int '* int) (list '*)))
 (list inotify-fd "path-to-watch" watch-flag) (list pointer-of-errno))

using this proposal, many "errno" like mechanisms can be handled,
for example, the h_errno of libc, etc.

further more, this proposal can be used to solve a sort of
requirements like make several calls atomic.

--
regards

bug#18592: FFI should have portable access to ‘errno’

[Ludovic Courtès]

Hi,

Sorry for the long delay.

Chaos Eternal <chaoseternal@shlug.org> skribis:

> Proposals to solve this bug:
>
> Proposal 1.
>
> Adding a keyword argument to pointer->procedure, if set to true, the
> generated wrapper will check 'errno' immediately after ffi_call and
> return the errno as second value.
>
> the proposed pointer->procedure maybe like this:
> pointer->procedure return_type func_ptr arg_types #:return-errno
>
> Proposal 2.
>
> let pointer->procedure check return_type, if it is a list:
> (func_return_type, 'errno)
> then return multiple values, as errno be second value.

That’s my favorite because it’s both pragmatic and extensible (we can
also add support for h_errno, etc.)

> Proposal 3.
>
> introduce another procedure "pointers->procedure", which will pack
> multiple function pointer into one procedure, in this procedure, the
> packed functions will be called in sequence, and their return value
> will be returned as multiple values.
>
> the interface would be like this:
> pointers->procedure (list-of-return-type) (list-of-pointers) (list-of arg-defs)
>
> also, we need a simple c-function deref-pointer-to-int, which will
> de-reference a pointer and return it's int value.
>
> using above tools, a proper system call with errno be returned could
> be like this:
>
> ((pointers->procedure
>     (list int int)
>     (list pointer-of-inotify-add-watch pointer-of-deref-pointer-to-int)
>     (list (list int '* int) (list '*)))
>  (list inotify-fd "path-to-watch" watch-flag) (list pointer-of-errno))

The problem is that POINTER-OF-ERRNO does not necessarily exist and
cannot be obtained portably.

Also, I find the interface a bit clumsy.

So my support goes to #2.  Would you like to give it a try?

Thanks for your input!

Ludo’.

bug#18592: FFI should have portable access to ‘errno’

[Mark H Weaver]

ludo@gnu.org (Ludovic Courtès) writes:

> Chaos Eternal <chaoseternal@shlug.org> skribis:
>
>> Proposals to solve this bug:
>>
>> Proposal 1.
>>
>> Adding a keyword argument to pointer->procedure, if set to true, the
>> generated wrapper will check 'errno' immediately after ffi_call and
>> return the errno as second value.
>>
>> the proposed pointer->procedure maybe like this:
>> pointer->procedure return_type func_ptr arg_types #:return-errno
>>
>> Proposal 2.
>>
>> let pointer->procedure check return_type, if it is a list:
>> (func_return_type, 'errno)
>> then return multiple values, as errno be second value.
>
> That’s my favorite because it’s both pragmatic and extensible (we can
> also add support for h_errno, etc.)

We can't do this, because although it's not documented in our manual, a
list passed as a foreign type already has a meaning: it means a struct.
See 'parse_ffi_type' in foreign.c.  I mentioned this fact on guile-user:

  https://lists.gnu.org/archive/html/guile-user/2012-05/msg00037.html

Of the proposals given here, I would support #1, but maybe there's a
better option.

     Thanks,
       Mark

bug#18592: FFI should have portable access to ‘errno’

[Mark H Weaver]

Mark H Weaver <mhw@netris.org> writes:

> ludo@gnu.org (Ludovic Courtès) writes:
>
>> Chaos Eternal <chaoseternal@shlug.org> skribis:
>>
>>> Proposal 2.
>>>
>>> let pointer->procedure check return_type, if it is a list:
>>> (func_return_type, 'errno)
>>> then return multiple values, as errno be second value.
>>
>> That’s my favorite because it’s both pragmatic and extensible (we can
>> also add support for h_errno, etc.)
>
> We can't do this, because although it's not documented in our manual, a
> list passed as a foreign type already has a meaning: it means a struct.
> See 'parse_ffi_type' in foreign.c.

Also see 'fill_ffi_type' in the same file.

    Mark

bug#18592: FFI should have portable access to ‘errno’

[Ludovic Courtès]

Mark H Weaver <mhw@netris.org> skribis:

> ludo@gnu.org (Ludovic Courtès) writes:
>
>> Chaos Eternal <chaoseternal@shlug.org> skribis:
>>
>>> Proposals to solve this bug:
>>>
>>> Proposal 1.
>>>
>>> Adding a keyword argument to pointer->procedure, if set to true, the
>>> generated wrapper will check 'errno' immediately after ffi_call and
>>> return the errno as second value.
>>>
>>> the proposed pointer->procedure maybe like this:
>>> pointer->procedure return_type func_ptr arg_types #:return-errno
>>>
>>> Proposal 2.
>>>
>>> let pointer->procedure check return_type, if it is a list:
>>> (func_return_type, 'errno)
>>> then return multiple values, as errno be second value.
>>
>> That’s my favorite because it’s both pragmatic and extensible (we can
>> also add support for h_errno, etc.)
>
> We can't do this, because although it's not documented in our manual, a
> list passed as a foreign type already has a meaning: it means a struct.
> See 'parse_ffi_type' in foreign.c.  I mentioned this fact on guile-user:
>
>   https://lists.gnu.org/archive/html/guile-user/2012-05/msg00037.html

Indeed, I had forgotten that.

> Of the proposals given here, I would support #1, but maybe there's a
> better option.

I agree #1 is now the best option so far.

Ludo’.

bug#18592: FFI should have portable access to ‘errno’

[Nala Ginrut]

[-- Attachment #1: Type: text/plain, Size: 874 bytes --]

Hi folks!
Here're patches (based on stable-2.0) to fix this issue according to
proposal 1.

Please review them, I'm going to write a new CFFI parser with nyacc, so
these patches is important for this plan. 

Thanks!

On Sat, 2015-01-24 at 11:33 +0100, Ludovic Courtès wrote:
> Mark H Weaver <mhw@netris.org> skribis:
> 
> > ludo@gnu.org (Ludovic Courtès) writes:
> >
> >> Chaos Eternal <chaoseternal@shlug.org> skribis:
> >>
> >>> Proposals to solve this bug:
> >>>
> >>> Proposal 1.
> >>>
> >>> Adding a keyword argument to pointer->procedure, if set to true, the
> >>> generated wrapper will check 'errno' immediately after ffi_call and
> >>> return the errno as second value.
> >>>
> >>> the proposed pointer->procedure maybe like this:
> >>> pointer->procedure return_type func_ptr arg_types #:return-errno

> I agree #1 is now the best option so far.
> 
> Ludo’.



[-- Attachment #2: 0001-Add-option-to-pointer-procedure-to-return-errno-if-n.patch --]
[-- Type: text/x-patch, Size: 4633 bytes --]

From 88a99af4b5db9096c3cde51c72eb371b6be76754 Mon Sep 17 00:00:00 2001
From: Nala Ginrut <nalaginrut@gmail.com>
Date: Thu, 31 Dec 2015 20:27:59 +0800
Subject: [PATCH 1/2] Add option to pointer->procedure to return errno if
 necessary

---
 libguile/foreign.c |   33 ++++++++++++++++++++++++---------
 libguile/foreign.h |    2 +-
 2 files changed, 25 insertions(+), 10 deletions(-)

diff --git a/libguile/foreign.c b/libguile/foreign.c
index 29cfc73..6909023 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
@@ -85,7 +85,7 @@ null_pointer_error (const char *func_name)
 }
 
 \f
-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 +753,29 @@ 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),
+SCM_DEFINE (scm_pointer_to_procedure, "pointer->procedure", 3, 1, 0,
+            (SCM return_type, SCM func_ptr, SCM arg_types, SCM return_errno),
             "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.")
+            "@code{return_type} should be a foreign type.\n"
+	    "@var{return_errno} is @code{#f} in default, if set to #t, then\n"
+	    "the @var{errno} will be returned as the second value.")
 #define FUNC_NAME s_scm_pointer_to_procedure
 {
   ffi_cif *cif;
 
   SCM_VALIDATE_POINTER (2, func_ptr);
 
+  if (SCM_UNLIKELY (SCM_UNBNDP (return_errno)))
+    return_errno = SCM_BOOL_F;
+
   cif = make_cif (return_type, arg_types, FUNC_NAME);
 
-  return cif_to_procedure (scm_from_pointer (cif, NULL), func_ptr);
+  return cif_to_procedure (scm_from_pointer (cif, NULL), func_ptr, return_errno);
 }
 #undef FUNC_NAME
 
@@ -940,7 +945,7 @@ 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;
@@ -949,7 +954,8 @@ cif_to_procedure (SCM cif, SCM func_ptr)
   objcode = get_objcode_trampoline (c_cif->nargs);
   
   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_cons (cif, scm_cons (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 +1122,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,9 +1161,16 @@ scm_i_foreign_call (SCM foreign, const SCM *argv)
   rvalue = (void *) ROUND_UP ((scm_t_uintptr) data + off,
 			      max (sizeof (void *), cif->rtype->alignment));
 
+  errno = 0;
   /* off we go! */
   ffi_call (cif, func, rvalue, args);
 
+  if (SCM_LIKELY (scm_is_true (return_errno)))
+    {
+      return scm_values (scm_list_2 (pack (cif->rtype, rvalue, 1),
+				     scm_from_int (errno)));
+    }
+
   return pack (cif->rtype, rvalue, 1);
 }
 
diff --git a/libguile/foreign.h b/libguile/foreign.h
index 41c0b65..8541526 100644
--- a/libguile/foreign.h
+++ b/libguile/foreign.h
@@ -93,7 +93,7 @@ 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 arg_types, SCM return_errno);
 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);
-- 
1.7.10.4


[-- Attachment #3: 0002-updated-pointer-procedure-in-document.patch --]
[-- Type: text/x-patch, Size: 1525 bytes --]

From 71151759513f8163e45c328e5bcae8e89ebbf614 Mon Sep 17 00:00:00 2001
From: Nala Ginrut <nalaginrut@gmail.com>
Date: Thu, 31 Dec 2015 20:28:36 +0800
Subject: [PATCH 2/2] updated pointer->procedure in document

---
 doc/ref/api-foreign.texi |    7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi
index c2c49ec..9fd09f5 100644
--- a/doc/ref/api-foreign.texi
+++ b/doc/ref/api-foreign.texi
@@ -813,8 +813,8 @@ 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 Procedure} scm_pointer_to_procedure (return_type, func_ptr, arg_types, return_errno)
 Make a foreign function.
 
 Given the foreign void pointer @var{func_ptr}, its argument and
@@ -825,6 +825,9 @@ 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.
+@var{return_errno} is @code{#f} in default, if set to @code{#t}, then @var{errno}
+will be returned as the second value.
+
 @end deffn
 
 Here is a better definition of @code{(math bessel)}:
-- 
1.7.10.4

bug#18592: FFI should have portable access to ‘errno’

[Nala Ginrut]

[-- Attachment #1: Type: text/plain, Size: 55 bytes --]

Resubmit since errno should be stored after ffi_call.


[-- Attachment #2: 0001-Add-option-to-pointer-procedure-to-return-errno-if-n.patch --]
[-- Type: text/x-patch, Size: 4633 bytes --]

From 88a99af4b5db9096c3cde51c72eb371b6be76754 Mon Sep 17 00:00:00 2001
From: Nala Ginrut <nalaginrut@gmail.com>
Date: Thu, 31 Dec 2015 20:27:59 +0800
Subject: [PATCH 1/2] Add option to pointer->procedure to return errno if
 necessary

---
 libguile/foreign.c |   33 ++++++++++++++++++++++++---------
 libguile/foreign.h |    2 +-
 2 files changed, 25 insertions(+), 10 deletions(-)

diff --git a/libguile/foreign.c b/libguile/foreign.c
index 29cfc73..6909023 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
@@ -85,7 +85,7 @@ null_pointer_error (const char *func_name)
 }
 
 \f
-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 +753,29 @@ 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),
+SCM_DEFINE (scm_pointer_to_procedure, "pointer->procedure", 3, 1, 0,
+            (SCM return_type, SCM func_ptr, SCM arg_types, SCM return_errno),
             "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.")
+            "@code{return_type} should be a foreign type.\n"
+	    "@var{return_errno} is @code{#f} in default, if set to #t, then\n"
+	    "the @var{errno} will be returned as the second value.")
 #define FUNC_NAME s_scm_pointer_to_procedure
 {
   ffi_cif *cif;
 
   SCM_VALIDATE_POINTER (2, func_ptr);
 
+  if (SCM_UNLIKELY (SCM_UNBNDP (return_errno)))
+    return_errno = SCM_BOOL_F;
+
   cif = make_cif (return_type, arg_types, FUNC_NAME);
 
-  return cif_to_procedure (scm_from_pointer (cif, NULL), func_ptr);
+  return cif_to_procedure (scm_from_pointer (cif, NULL), func_ptr, return_errno);
 }
 #undef FUNC_NAME
 
@@ -940,7 +945,7 @@ 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;
@@ -949,7 +954,8 @@ cif_to_procedure (SCM cif, SCM func_ptr)
   objcode = get_objcode_trampoline (c_cif->nargs);
   
   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_cons (cif, scm_cons (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 +1122,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,9 +1161,16 @@ scm_i_foreign_call (SCM foreign, const SCM *argv)
   rvalue = (void *) ROUND_UP ((scm_t_uintptr) data + off,
 			      max (sizeof (void *), cif->rtype->alignment));
 
+  errno = 0;
   /* off we go! */
   ffi_call (cif, func, rvalue, args);
 
+  if (SCM_LIKELY (scm_is_true (return_errno)))
+    {
+      return scm_values (scm_list_2 (pack (cif->rtype, rvalue, 1),
+				     scm_from_int (errno)));
+    }
+
   return pack (cif->rtype, rvalue, 1);
 }
 
diff --git a/libguile/foreign.h b/libguile/foreign.h
index 41c0b65..8541526 100644
--- a/libguile/foreign.h
+++ b/libguile/foreign.h
@@ -93,7 +93,7 @@ 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 arg_types, SCM return_errno);
 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);
-- 
1.7.10.4


[-- Attachment #3: 0002-updated-pointer-procedure-in-document.patch --]
[-- Type: text/x-patch, Size: 1525 bytes --]

From 71151759513f8163e45c328e5bcae8e89ebbf614 Mon Sep 17 00:00:00 2001
From: Nala Ginrut <nalaginrut@gmail.com>
Date: Thu, 31 Dec 2015 20:28:36 +0800
Subject: [PATCH 2/2] updated pointer->procedure in document

---
 doc/ref/api-foreign.texi |    7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi
index c2c49ec..9fd09f5 100644
--- a/doc/ref/api-foreign.texi
+++ b/doc/ref/api-foreign.texi
@@ -813,8 +813,8 @@ 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 Procedure} scm_pointer_to_procedure (return_type, func_ptr, arg_types, return_errno)
 Make a foreign function.
 
 Given the foreign void pointer @var{func_ptr}, its argument and
@@ -825,6 +825,9 @@ 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.
+@var{return_errno} is @code{#f} in default, if set to @code{#t}, then @var{errno}
+will be returned as the second value.
+
 @end deffn
 
 Here is a better definition of @code{(math bessel)}:
-- 
1.7.10.4

bug#18592: FFI should have portable access to ‘errno’

[Mark H Weaver]

Hi Nala,

Thanks for working on this :)
Please see below for comments.

Nala Ginrut <nalaginrut@gmail.com> writes:

> From 88a99af4b5db9096c3cde51c72eb371b6be76754 Mon Sep 17 00:00:00 2001
> From: Nala Ginrut <nalaginrut@gmail.com>
> Date: Thu, 31 Dec 2015 20:27:59 +0800
> Subject: [PATCH 1/2] Add option to pointer->procedure to return errno if
>  necessary
>
> ---
>  libguile/foreign.c |   33 ++++++++++++++++++++++++---------
>  libguile/foreign.h |    2 +-
>  2 files changed, 25 insertions(+), 10 deletions(-)
>
> diff --git a/libguile/foreign.c b/libguile/foreign.c
> index 29cfc73..6909023 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
> @@ -85,7 +85,7 @@ null_pointer_error (const char *func_name)
>  }
>  
>  \f
> -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 +753,29 @@ 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),
> +SCM_DEFINE (scm_pointer_to_procedure, "pointer->procedure", 3, 1, 0,
> +            (SCM return_type, SCM func_ptr, SCM arg_types, SCM return_errno),

Is this patch intended for 2.0.x?  Unfortunately, we cannot change the
signature of a C API function in 2.0.x, because it would change the ABI
and thus break any C code compiled against guile-2.0.11 that calls
scm_pointer_to_procedure.

Also, the proposal that we agreed upon was to add a #:return-errno?
keyword argument, not an optional positional argument.

We didn't discuss what the C API should look like.  We cannot change the
signature of 'scm_pointer_to_procedure' in 2.0.x, and I guess it would
be better to leave it unchanged in 2.2+ as well, to avoid
incompatibilities between C code written for 2.0 vs 2.2.

One possibility is to keep 'scm_pointer_to_procedure' as it is, and add
a new C API function 'scm_pointer_to_procedure_with_errno' that accepts
the same arguments but implies #:return-errno? #t.

If we adopt this approach, then this C function defined with SCM_DEFINE,
which accepts keyword arguments and corresponds to 'pointer->procedure',
will not be part of the public C API and thus not declared in foreign.h.

Thoughts?

I suggest that you look at commit 3ace9a8e4e, which added keyword
arguments to 'open-file' while keeping the API of 'scm_open_file'
unchanged.  It shows the preferred approach for handling keyword
arguments from C.

>              "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.")
> +            "@code{return_type} should be a foreign type.\n"
> +	    "@var{return_errno} is @code{#f} in default, if set to #t, then\n"
> +	    "the @var{errno} will be returned as the second value.")

"If @var{return_errno} is true, then @code{errno} will be returned as a
second return value."

Also, please use spaces instead of tabs to indent here, for consistency
with the existing code.

>  #define FUNC_NAME s_scm_pointer_to_procedure
>  {
>    ffi_cif *cif;
>  
>    SCM_VALIDATE_POINTER (2, func_ptr);
>  
> +  if (SCM_UNLIKELY (SCM_UNBNDP (return_errno)))
> +    return_errno = SCM_BOOL_F;
> +

Please remove SCM_UNLIKELY here.  SCM_UNBNDP (return_errno) is not
unlikely.

>    cif = make_cif (return_type, arg_types, FUNC_NAME);
>  
> -  return cif_to_procedure (scm_from_pointer (cif, NULL), func_ptr);
> +  return cif_to_procedure (scm_from_pointer (cif, NULL), func_ptr, return_errno);

Please keep lines within 80 columns.

>  }
>  #undef FUNC_NAME
>  
> @@ -940,7 +945,7 @@ 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;
> @@ -949,7 +954,8 @@ cif_to_procedure (SCM cif, SCM func_ptr)
>    objcode = get_objcode_trampoline (c_cif->nargs);
>    
>    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_cons (cif, scm_cons (func_ptr, return_errno)));

You could use 'scm_cons2' here: scm_cons2 (cif, func_ptr, return_errno)
is equivalent to the code above.

Also, before storing 'return_errno', it would be good to convert it to a
simple boolean.  For example, if a user does this:

  (pointer->procedure ... #:return-errno? (assoc 'errno options))

then 'return_errno' will be a pair, and in general it could be a large
data structure which is simply meant to be interpreted as #t, but it
would be wasteful to retain a reference to that object and prevent it
from being garbage collected.  So, how about putting something like the
following code near the beginning of the function?

  /* 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));

>    SCM_SIMPLE_VECTOR_SET (table, 1, SCM_BOOL_F); /* name */
>    ret = scm_make_program (objcode, table, SCM_BOOL_F);
>    
> @@ -1116,9 +1122,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,9 +1161,16 @@ scm_i_foreign_call (SCM foreign, const SCM *argv)
>    rvalue = (void *) ROUND_UP ((scm_t_uintptr) data + off,
>  			      max (sizeof (void *), cif->rtype->alignment));
>  
> +  errno = 0;

Please do not touch 'errno' unless scm_is_true (return_errno).

To avoid testing scm_is_true (return_errno) twice, I would recommend
calling 'ffi_call' within both branches of the 'if' statement.

>    /* off we go! */
>    ffi_call (cif, func, rvalue, args);
>  
> +  if (SCM_LIKELY (scm_is_true (return_errno)))

Please remove SCM_LIKELY.

> +    {
> +      return scm_values (scm_list_2 (pack (cif->rtype, rvalue, 1),
> +				     scm_from_int (errno)));

Please copy 'errno' to a local variable immediately after the call to
'ffi_call'.  In the code above, 'pack' and 'scm_list_2' are called
before 'errno' is read.  'scm_list_2' does GC allocation, and thus could
trigger a garbage collection which I guess would change 'errno'.  'pack'
might also do so.

> +    }
> +
>    return pack (cif->rtype, rvalue, 1);
>  }
>  
> diff --git a/libguile/foreign.h b/libguile/foreign.h
> index 41c0b65..8541526 100644
> --- a/libguile/foreign.h
> +++ b/libguile/foreign.h

Please add 2016 to this file's copyright dates.

> @@ -93,7 +93,7 @@ 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 arg_types, SCM return_errno);

This will need to be updated to account for the C API issues discussed
above.

>  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);
> -- 
> 1.7.10.4
>
>
> From 71151759513f8163e45c328e5bcae8e89ebbf614 Mon Sep 17 00:00:00 2001
> From: Nala Ginrut <nalaginrut@gmail.com>
> Date: Thu, 31 Dec 2015 20:28:36 +0800
> Subject: [PATCH 2/2] updated pointer->procedure in document
>
> ---
>  doc/ref/api-foreign.texi |    7 +++++--
>  1 file changed, 5 insertions(+), 2 deletions(-)
>
> diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi
> index c2c49ec..9fd09f5 100644
> --- a/doc/ref/api-foreign.texi
> +++ b/doc/ref/api-foreign.texi
> @@ -813,8 +813,8 @@ 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 Procedure} scm_pointer_to_procedure (return_type, func_ptr, arg_types, return_errno)

This will also need to be updated to account for the C API issues
discussed above.

>  Make a foreign function.
>  
>  Given the foreign void pointer @var{func_ptr}, its argument and
> @@ -825,6 +825,9 @@ 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.
> +@var{return_errno} is @code{#f} in default, if set to @code{#t}, then @var{errno}
> +will be returned as the second value.

If @var{return_errno} is true, then @code{errno} will be returned as the
second return value.

> +
>  @end deffn
>  
>  Here is a better definition of @code{(math bessel)}:

      Thanks!
        Mark

bug#18592: FFI should have portable access to ‘errno’

[Nala Ginrut]

[-- Attachment #1: Type: text/plain, Size: 526 bytes --]

Hi Mark!
Thanks for all the advices.

Here's the new patch according to your advices.
Include:
1. Added new procedure pointer->procedure-with-errno with
#:return-errno?

Question: Should we make #:return-errno? true in default? This would
make the name *-with-errno more reasonable. At present, it's false in
default.

2. Used scm_cons2

3. Store errno to a local var after ffi_call immediately.

4. Set errno=0 only when #:return-errno? is true.

5. Merged all modifications into one patch.

Comments please.

Best regards.


[-- Attachment #2: 0001-Added-new-function-pointer-procedure-with-errno-to-r.patch --]
[-- Type: text/x-patch, Size: 17576 bytes --]

From 500b8b1f5079a56e3cd5c0a8386b3f880f396e01 Mon Sep 17 00:00:00 2001
From: Nala Ginrut <nalaginrut@gmail.com>
Date: Tue, 5 Jan 2016 03:04:47 +0800
Subject: [PATCH] Added new function pointer->procedure-with-errno to return
 errno properly

* doc/ref/api-foreign.texi (Dynamic FFI): Update documentation.

* libguile/foreign.c (scm_pointer_to_procedure_with_errno):
  New API function to return errno properly after calling foreign function.

  (cif_to_procedure): Support return_errno option.

* libguile/foreign.h (scm_pointer_to_procedure_with_errno): Add prototypes.

* module/system/foreign.scm: Export pointer->procedure-with-errno.
---
 doc/ref/api-foreign.texi  |   17 +++++
 libguile/foreign.c        |  168 +++++++++++++++++++++++++++++----------------
 libguile/foreign.h        |    8 ++-
 module/system/foreign.scm |    1 +
 4 files changed, 132 insertions(+), 62 deletions(-)

diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi
index c2c49ec..a7e9fc1 100644
--- a/doc/ref/api-foreign.texi
+++ b/doc/ref/api-foreign.texi
@@ -827,6 +827,23 @@ and return appropriate values.
 more information on foreign types.
 @end deffn
 
+@deffn {Scheme Procedure} pointer->procedure-with-errno return_type func_ptr arg_types @
+        [#:return-errno?=#f]
+@deffnx {C Procedure} scm_pointer_to_procedure_with_errno (return_type, func_ptr, @
+         keyword_args)
+Make a foreign function with errno.
+
+Given the foreign void pointer @var{func_ptr}, its argument and
+return types @var{arg_types} and @var{return_type}, return a
+procedure that will pass arguments to the foreign function
+and return appropriate values. If @var{#:return-errno?} is true, then @code{errno} will be
+returned as the second return value.
+
+@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.
+@end deffn
+
 Here is a better definition of @code{(math bessel)}:
 
 @example
diff --git a/libguile/foreign.c b/libguile/foreign.c
index 29cfc73..137c34d 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
@@ -81,11 +81,11 @@ static void
 null_pointer_error (const char *func_name)
 {
   scm_error (sym_null_pointer_error, func_name,
-	     "null pointer dereference", SCM_EOL, SCM_EOL);
+             "null pointer dereference", SCM_EOL, SCM_EOL);
 }
 
 \f
-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;
@@ -108,9 +108,9 @@ pointer_finalizer_trampoline (void *ptr, void *data)
 }
 
 SCM_DEFINE (scm_pointer_p, "pointer?", 1, 0, 0,
-	    (SCM obj),
-	    "Return @code{#t} if @var{obj} is a pointer object, "
-	    "@code{#f} otherwise.\n")
+            (SCM obj),
+            "Return @code{#t} if @var{obj} is a pointer object, "
+            "@code{#f} otherwise.\n")
 #define FUNC_NAME s_scm_pointer_p
 {
   return scm_from_bool (SCM_POINTER_P (obj));
@@ -118,11 +118,11 @@ SCM_DEFINE (scm_pointer_p, "pointer?", 1, 0, 0,
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_make_pointer, "make-pointer", 1, 1, 0,
-	    (SCM address, SCM finalizer),
-	    "Return a foreign pointer object pointing to @var{address}. "
-	    "If @var{finalizer} is passed, it should be a pointer to a "
-	    "one-argument C function that will be called when the pointer "
-	    "object becomes unreachable.")
+            (SCM address, SCM finalizer),
+            "Return a foreign pointer object pointing to @var{address}. "
+            "If @var{finalizer} is passed, it should be a pointer to a "
+            "one-argument C function that will be called when the pointer "
+            "object becomes unreachable.")
 #define FUNC_NAME s_scm_make_pointer
 {
   void *c_finalizer;
@@ -170,8 +170,8 @@ scm_from_pointer (void *ptr, scm_t_pointer_finalizer finalizer)
 }
 
 SCM_DEFINE (scm_pointer_address, "pointer-address", 1, 0, 0,
-	    (SCM pointer),
-	    "Return the numerical value of @var{pointer}.")
+            (SCM pointer),
+            "Return the numerical value of @var{pointer}.")
 #define FUNC_NAME s_scm_pointer_address
 {
   SCM_VALIDATE_POINTER (1, pointer);
@@ -181,9 +181,9 @@ SCM_DEFINE (scm_pointer_address, "pointer-address", 1, 0, 0,
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_pointer_to_scm, "pointer->scm", 1, 0, 0,
-	    (SCM pointer),
-	    "Unsafely cast @var{pointer} to a Scheme object.\n"
-	    "Cross your fingers!")
+            (SCM pointer),
+            "Unsafely cast @var{pointer} to a Scheme object.\n"
+            "Cross your fingers!")
 #define FUNC_NAME s_scm_pointer_to_scm
 {
   SCM_VALIDATE_POINTER (1, pointer);
@@ -193,8 +193,8 @@ SCM_DEFINE (scm_pointer_to_scm, "pointer->scm", 1, 0, 0,
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_scm_to_pointer, "scm->pointer", 1, 0, 0,
-	    (SCM scm),
-	    "Return a foreign pointer object with the @code{object-address}\n"
+            (SCM scm),
+            "Return a foreign pointer object with the @code{object-address}\n"
             "of @var{scm}.")
 #define FUNC_NAME s_scm_scm_to_pointer
 {
@@ -209,18 +209,18 @@ SCM_DEFINE (scm_scm_to_pointer, "scm->pointer", 1, 0, 0,
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_pointer_to_bytevector, "pointer->bytevector", 2, 2, 0,
-	    (SCM pointer, SCM len, SCM offset, SCM uvec_type),
-	    "Return a bytevector aliasing the @var{len} bytes pointed\n"
-	    "to by @var{pointer}.\n\n"
+            (SCM pointer, SCM len, SCM offset, SCM uvec_type),
+            "Return a bytevector aliasing the @var{len} bytes pointed\n"
+            "to by @var{pointer}.\n\n"
             "The user may specify an alternate default interpretation for\n"
             "the memory by passing the @var{uvec_type} argument, to indicate\n"
             "that the memory is an array of elements of that type.\n"
             "@var{uvec_type} should be something that\n"
             "@code{uniform-vector-element-type} would return, like @code{f32}\n"
             "or @code{s16}.\n\n"
-	    "When @var{offset} is passed, it specifies the offset in bytes\n"
-	    "relative to @var{pointer} of the memory region aliased by the\n"
-	    "returned bytevector.")
+            "When @var{offset} is passed, it specifies the offset in bytes\n"
+            "relative to @var{pointer} of the memory region aliased by the\n"
+            "returned bytevector.")
 #define FUNC_NAME s_scm_pointer_to_bytevector
 {
   SCM ret;
@@ -273,17 +273,17 @@ SCM_DEFINE (scm_pointer_to_bytevector, "pointer->bytevector", 2, 2, 0,
   blen = scm_to_size_t (len);
 
   ret = scm_c_take_typed_bytevector ((signed char *) ptr + boffset,
-				     blen, btype);
+                                     blen, btype);
   register_weak_reference (ret, pointer);
   return ret;
 }
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_bytevector_to_pointer, "bytevector->pointer", 1, 1, 0,
-	    (SCM bv, SCM offset),
-	    "Return a pointer pointer aliasing the memory pointed to by\n"
+            (SCM bv, SCM offset),
+            "Return a pointer pointer aliasing the memory pointed to by\n"
             "@var{bv} or @var{offset} bytes after @var{bv} when @var{offset}\n"
-	    "is passed.")
+            "is passed.")
 #define FUNC_NAME s_scm_bytevector_to_pointer
 {
   SCM ret;
@@ -337,9 +337,9 @@ scm_i_pointer_print (SCM pointer, SCM port, scm_print_state *pstate)
    (heap allocation overhead, Scheme/C round trips, etc.)  */
 
 SCM_DEFINE (scm_dereference_pointer, "dereference-pointer", 1, 0, 0,
-	    (SCM pointer),
-	    "Assuming @var{pointer} points to a memory region that\n"
-	    "holds a pointer, return this pointer.")
+            (SCM pointer),
+            "Assuming @var{pointer} points to a memory region that\n"
+            "holds a pointer, return this pointer.")
 #define FUNC_NAME s_scm_dereference_pointer
 {
   void **ptr;
@@ -355,9 +355,9 @@ SCM_DEFINE (scm_dereference_pointer, "dereference-pointer", 1, 0, 0,
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_string_to_pointer, "string->pointer", 1, 1, 0,
-	    (SCM string, SCM encoding),
-	    "Return a foreign pointer to a nul-terminated copy of\n"
-	    "@var{string} in the given @var{encoding}, defaulting to\n"
+            (SCM string, SCM encoding),
+            "Return a foreign pointer to a nul-terminated copy of\n"
+            "@var{string} in the given @var{encoding}, defaulting to\n"
             "the current locale encoding.  The C string is freed when\n"
             "the returned foreign pointer becomes unreachable.\n\n"
             "This is the Scheme equivalent of @code{scm_to_stringn}.")
@@ -394,14 +394,14 @@ SCM_DEFINE (scm_string_to_pointer, "string->pointer", 1, 1, 0,
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_pointer_to_string, "pointer->string", 1, 2, 0,
-	    (SCM pointer, SCM length, SCM encoding),
-	    "Return the string representing the C string pointed to by\n"
+            (SCM pointer, SCM length, SCM encoding),
+            "Return the string representing the C string pointed to by\n"
             "@var{pointer}.  If @var{length} is omitted or @code{-1}, the\n"
             "string is assumed to be nul-terminated.  Otherwise\n"
             "@var{length} is the number of bytes in memory pointed to by\n"
             "@var{pointer}.  The C string is assumed to be in the given\n"
             "@var{encoding}, defaulting to the current locale encoding.\n\n"
-	    "This is the Scheme equivalent of @code{scm_from_stringn}.")
+            "This is the Scheme equivalent of @code{scm_from_stringn}.")
 #define FUNC_NAME s_scm_pointer_to_string
 {
   size_t len;
@@ -482,19 +482,19 @@ SCM_DEFINE (scm_alignof, "alignof", 1, 0, 0, (SCM type),
   else if (scm_is_pair (type))
     {
       /* TYPE is a structure.  Section 3-3 of the i386, x86_64, PowerPC,
-	 and SPARC P.S. of the System V ABI all say: "Aggregates
-	 (structures and arrays) and unions assume the alignment of
-	 their most strictly aligned component."  */
+         and SPARC P.S. of the System V ABI all say: "Aggregates
+         (structures and arrays) and unions assume the alignment of
+         their most strictly aligned component."  */
       size_t max;
 
       for (max = 0; scm_is_pair (type); type = SCM_CDR (type))
-	{
-	  size_t align;
+        {
+          size_t align;
 
-	  align = scm_to_size_t (scm_alignof (SCM_CAR (type)));
-	  if (align  > max)
-	    max = align;
-	}
+          align = scm_to_size_t (scm_alignof (SCM_CAR (type)));
+          if (align  > max)
+            max = align;
+        }
 
       return scm_from_size_t (max);
     }
@@ -708,12 +708,12 @@ make_cif (SCM return_type, SCM arg_types, const char *caller)
   /* then ffi_type pointers: one for each arg, one for each struct
      element, and one for each struct (for null-termination) */
   cif_len = (ROUND_UP (cif_len, alignof_type (void *))
-	     + (nargs + n_structs + n_struct_elts)*sizeof(void*));
+             + (nargs + n_structs + n_struct_elts)*sizeof(void*));
 
   /* then the ffi_type structs themselves, one per arg and struct element, and
      one for the return val */
   cif_len = (ROUND_UP (cif_len, alignof_type (ffi_type))
-	     + (nargs + n_struct_elts + 1)*sizeof(ffi_type));
+             + (nargs + n_struct_elts + 1)*sizeof(ffi_type));
 
   mem = scm_gc_malloc_pointerless (cif_len, "foreign");
   /* ensure all the memory is initialized, even the holes */
@@ -724,8 +724,8 @@ make_cif (SCM return_type, SCM arg_types, const char *caller)
   cif_len = ROUND_UP (sizeof (ffi_cif), alignof_type (void *));
   type_ptrs = (ffi_type**)(mem + cif_len);
   cif_len = ROUND_UP (cif_len
-		      + (nargs + n_structs + n_struct_elts)*sizeof(void*),
-		      alignof_type (ffi_type));
+                      + (nargs + n_structs + n_struct_elts)*sizeof(void*),
+                      alignof_type (ffi_type));
   types = (ffi_type*)(mem + cif_len);
 
   /* whew. now knit the pointers together. */
@@ -746,7 +746,7 @@ make_cif (SCM return_type, SCM arg_types, const char *caller)
   cif->flags = 0;
 
   if (FFI_OK != ffi_prep_cif (cif, FFI_DEFAULT_ABI, cif->nargs, cif->rtype,
-			      cif->arg_types))
+                              cif->arg_types))
     SCM_MISC_ERROR ("ffi_prep_cif failed", SCM_EOL);
 
   return cif;
@@ -770,7 +770,39 @@ SCM_DEFINE (scm_pointer_to_procedure, "pointer->procedure", 3, 0, 0,
 
   cif = make_cif (return_type, arg_types, FUNC_NAME);
 
-  return cif_to_procedure (scm_from_pointer (cif, NULL), func_ptr);
+  return cif_to_procedure (scm_from_pointer (cif, NULL), func_ptr, SCM_BOOL_F);
+}
+#undef FUNC_NAME
+
+SCM_KEYWORD (k_return_errno, "return-errno?");
+
+SCM_DEFINE (scm_pointer_to_procedure_with_errno,
+            "pointer->procedure-with-errno", 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.\n"
+            "If @var{#:return-errno?} is true, then the @var{errno} will be\n"
+            "returned as the second value.")
+#define FUNC_NAME s_scm_pointer_to_procedure_with_errno
+{
+  ffi_cif *cif;
+  SCM return_errno = SCM_BOOL_F;
+
+  SCM_VALIDATE_POINTER (2, func_ptr);
+  
+  scm_c_bind_keyword_arguments (FUNC_NAME, keyword_args, 0,
+                                k_return_errno, &return_errno,
+				SCM_UNDEFINED);
+
+  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
 
@@ -940,16 +972,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;
 
+  /* 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));
+
   c_cif = (ffi_cif *) SCM_POINTER_VALUE (cif);
   objcode = get_objcode_trampoline (c_cif->nargs);
   
   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 +1152,12 @@ scm_i_foreign_call (SCM foreign, const SCM *argv)
   unsigned i;
   size_t arg_size;
   scm_t_ptrdiff off;
+  SCM return_errno;
+  int reterr;
 
   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 +1192,21 @@ 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);
-
-  return pack (cif->rtype, rvalue, 1);
+  if (scm_is_true (return_errno))
+    {
+      errno = 0;
+      /* off we go! */
+      ffi_call (cif, func, rvalue, args);
+      reterr = errno;
+      return scm_values (scm_list_2 (pack (cif->rtype, rvalue, 1),
+				     scm_from_int (reterr)));
+    }
+  else
+    {
+      /* off we go! */
+      ffi_call (cif, func, rvalue, args);
+      return pack (cif->rtype, rvalue, 1);
+    }
 }
 
 \f
diff --git a/libguile/foreign.h b/libguile/foreign.h
index 41c0b65..060bd24 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
@@ -93,9 +93,11 @@ 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 arg_types);
+SCM_API SCM scm_pointer_to_procedure_with_errno (SCM return_type, SCM func_ptr,
+                                                 SCM arg_types, SCM keyword_args);
 SCM_API SCM scm_procedure_to_pointer (SCM return_type, SCM func_ptr,
-				      SCM arg_types);
+                                      SCM arg_types);
 SCM_INTERNAL SCM scm_i_foreign_call (SCM foreign, const SCM *argv);
 
 \f
diff --git a/module/system/foreign.scm b/module/system/foreign.scm
index 55ab014..4436f1f 100644
--- a/module/system/foreign.scm
+++ b/module/system/foreign.scm
@@ -50,6 +50,7 @@
             pointer->string
 
             pointer->procedure
+            pointer->procedure-with-errno
             ;; procedure->pointer (see below)
             make-c-struct parse-c-struct
 
-- 
1.7.10.4

bug#18592: FFI should have portable access to ‘errno’

[Chaos Eternal]

On Tue, Jan 5, 2016 at 3:14 AM, Nala Ginrut <nalaginrut@gmail.com> wrote:
> Hi Mark!
> Thanks for all the advices.
>
> Here's the new patch according to your advices.
> Include:
> 1. Added new procedure pointer->procedure-with-errno with
> #:return-errno?
>
> Question: Should we make #:return-errno? true in default? This would
> make the name *-with-errno more reasonable. At present, it's false in
> default.
>

I suggest that if we have this new procedure, we don't need keyword
option "#:return-errno?" since the procedure name itself implies it.
Also if old behavior is needed, the old procedure pointer->procedure
still can be employed.

> 2. Used scm_cons2
>
> 3. Store errno to a local var after ffi_call immediately.
>
> 4. Set errno=0 only when #:return-errno? is true.
>
> 5. Merged all modifications into one patch.
>
> Comments please.
>
> Best regards.
>

bug#18592: FFI should have portable access to ‘errno’

[tomas]

-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

On Tue, Jan 05, 2016 at 10:24:35AM +0800, Chaos Eternal wrote:
> On Tue, Jan 5, 2016 at 3:14 AM, Nala Ginrut <nalaginrut@gmail.com> wrote:
> > Hi Mark!
> > Thanks for all the advices.
> >
> > Here's the new patch according to your advices.
> > Include:
> > 1. Added new procedure pointer->procedure-with-errno with
> > #:return-errno?
> >
> > Question: Should we make #:return-errno? true in default? This would
> > make the name *-with-errno more reasonable. At present, it's false in
> > default.

Sorry for intervening from the peanut gallery, but if I understood Mark
correctly, he only was proposing to introduce a second function for the
C API (to keep backward compatibility at the linking-to-C level). At the
Guile source level, I guess all can be subsumed under one function.

regards
- -- tomás
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.12 (GNU/Linux)

iEYEARECAAYFAlaLdYQACgkQBcgs9XrR2kYBUQCfXIbqu8h/fhM/PyM9NXI1tR9M
thIAnjSo00Ts4P39cTdwGOIIXIzELU9A
=cCFX
-----END PGP SIGNATURE-----

bug#18592: FFI should have portable access to ‘errno’

[Nala Ginrut]

On Tue, 2016-01-05 at 08:49 +0100, tomas@tuxteam.de wrote:
> Sorry for intervening from the peanut gallery, but if I understood Mark
> correctly, he only was proposing to introduce a second function for the
> C API (to keep backward compatibility at the linking-to-C level). At the
> Guile source level, I guess all can be subsumed under one function.
> 

If we want to combine them in Scheme level, we have to change the name
"pointer->procedure" in  C level, since it's registered with SCM_DEFINE.
Dunno if it breaks the ABI too.

I think it's fine to make it two. And maybe keep
pointer->procedure-with-errno in future version (say, 3.0), which may
change ABI a lot. It's inevitable to change ABI in major version number
change usually.

bug#18592: FFI should have portable access to ‘errno’

[Mark H Weaver]

Nala Ginrut <nalaginrut@gmail.com> writes:

> On Tue, 2016-01-05 at 08:49 +0100, tomas@tuxteam.de wrote:
>> Sorry for intervening from the peanut gallery, but if I understood Mark
>> correctly, he only was proposing to introduce a second function for the
>> C API (to keep backward compatibility at the linking-to-C level). At the
>> Guile source level, I guess all can be subsumed under one function.

Yes, Tomás is correct.  For the Scheme API, I would prefer to keep just
one procedure 'pointer->procedure' that accepts an optional
#:return-errno? keyword argument, as we had previously agreed.

> If we want to combine them in Scheme level, we have to change the name
> "pointer->procedure" in  C level, since it's registered with SCM_DEFINE.

That's right, the C function name in the SCM_DEFINE construct would need
to have a different name and be private, perhaps something like
'scm_i_pointer_to_procedure_with_keywords'.

> Dunno if it breaks the ABI too.

As long as there still exists a 'scm_pointer_to_procedure' function with
the same signature and semantics as it has now, that will preserve ABI
compatibility.

More specifically, here's what I'd suggest:

* A new, static, 'pointer_to_procedure' C function that inherits the
  signature and body of 'scm_pointer_to_procedure' but with a new and
  required 'return_errno' argument.  The other functions below would be
  wrappers for this function.

* A new private 'scm_i_pointer_to_procedure_with_keywords' C function,
  defined using SCM_DEFINE and bound to 'pointer->procedure' in Scheme,
  that uses 'scm_c_bind_keyword_arguments' and calls
  'pointer_to_procedure'.

* The C API function 'scm_pointer_to_procedure', which has the same
  arguments as in Guile 2.0.11 and calls 'pointer_to_procedure' with
  'return_errno' set to SCM_BOOL_F.

* A new C API function 'scm_pointer_to_procedure_with_errno', which is
  identical to 'scm_pointer_to_procedure' except that it calls
  'pointer_to_procedure' with 'return_errno' set to SCM_BOOL_T.

The only change to foreign.h would be to add a prototype for
'scm_pointer_to_procedure_with_errno'.

What do you think?

      Regards,
        Mark

bug#18592: FFI should have portable access to ‘errno’

[Nala Ginrut]

[-- Attachment #1: Type: text/plain, Size: 1174 bytes --]

Here's updated patch

Thanks!

On Tue, 2016-01-05 at 10:08 -0500, Mark H Weaver wrote:
> More specifically, here's what I'd suggest:
> 
> * A new, static, 'pointer_to_procedure' C function that inherits the
>   signature and body of 'scm_pointer_to_procedure' but with a new and
>   required 'return_errno' argument.  The other functions below would be
>   wrappers for this function.
> 
> * A new private 'scm_i_pointer_to_procedure_with_keywords' C function,
>   defined using SCM_DEFINE and bound to 'pointer->procedure' in Scheme,
>   that uses 'scm_c_bind_keyword_arguments' and calls
>   'pointer_to_procedure'.
> 
> * The C API function 'scm_pointer_to_procedure', which has the same
>   arguments as in Guile 2.0.11 and calls 'pointer_to_procedure' with
>   'return_errno' set to SCM_BOOL_F.
> 
> * A new C API function 'scm_pointer_to_procedure_with_errno', which is
>   identical to 'scm_pointer_to_procedure' except that it calls
>   'pointer_to_procedure' with 'return_errno' set to SCM_BOOL_T.
> 
> The only change to foreign.h would be to add a prototype for
> 'scm_pointer_to_procedure_with_errno'.
> 
> What do you think?
> 
>       Regards,
>         Mark


[-- Attachment #2: 0001-Added-new-function-pointer-procedure-with-errno-to-r.patch --]
[-- Type: text/x-patch, Size: 19848 bytes --]

From faa6371c3251a488e4245bf4835529009a1a7b88 Mon Sep 17 00:00:00 2001
From: Nala Ginrut <nalaginrut@gmail.com>
Date: Tue, 5 Jan 2016 03:04:47 +0800
Subject: [PATCH] Added new function pointer->procedure-with-errno to return
 errno properly

* doc/ref/api-foreign.texi (Dynamic FFI): Update documentation.

* libguile/foreign.c (scm_pointer_to_procedure_with_errno):
  New API function to return errno properly after calling foreign function.

  (pointer_to_procedure): New internal function to support return_errno option.

* libguile/foreign.h (scm_pointer_to_procedure_with_errno): Add prototypes.

* module/system/foreign.scm: Export pointer->procedure-with-errno.
---
 doc/ref/api-foreign.texi  |   23 +++++-
 libguile/foreign.c        |  199 +++++++++++++++++++++++++++++++--------------
 libguile/foreign.h        |    8 +-
 module/system/foreign.scm |    1 +
 4 files changed, 165 insertions(+), 66 deletions(-)

diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi
index c2c49ec..52184e2 100644
--- a/doc/ref/api-foreign.texi
+++ b/doc/ref/api-foreign.texi
@@ -813,14 +813,31 @@ 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 Procedure} scm_pointer_to_procedure (return_type, func_ptr, arg_types, keyword_args)
 Make a foreign function.
 
 Given the foreign void pointer @var{func_ptr}, its argument and
 return types @var{arg_types} and @var{return_type}, return a
 procedure that will pass arguments to the foreign function
-and return appropriate values.
+and return appropriate values. If @var{#:return-errno?} is true, then @code{errno} will be
+returned as the second return value.
+
+@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.
+@end deffn
+
+@deffn {Scheme Procedure} pointer->procedure-with-errno return_type func_ptr arg_types
+@deffnx {C Procedure} scm_pointer_to_procedure_with_errno (return_type, func_ptr, arg_types)
+Make a foreign function with errno.
+
+Given the foreign void pointer @var{func_ptr}, its argument and
+return types @var{arg_types} and @var{return_type}, return a
+procedure that will pass arguments to the foreign function
+and return appropriate values. The @code{errno} will be
+returned as the second return value.
 
 @var{arg_types} should be a list of foreign types.
 @code{return_type} should be a foreign type. @xref{Foreign Types}, for
diff --git a/libguile/foreign.c b/libguile/foreign.c
index 29cfc73..b0fd2dd 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
@@ -81,11 +81,11 @@ static void
 null_pointer_error (const char *func_name)
 {
   scm_error (sym_null_pointer_error, func_name,
-	     "null pointer dereference", SCM_EOL, SCM_EOL);
+             "null pointer dereference", SCM_EOL, SCM_EOL);
 }
 
 \f
-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;
@@ -108,9 +108,9 @@ pointer_finalizer_trampoline (void *ptr, void *data)
 }
 
 SCM_DEFINE (scm_pointer_p, "pointer?", 1, 0, 0,
-	    (SCM obj),
-	    "Return @code{#t} if @var{obj} is a pointer object, "
-	    "@code{#f} otherwise.\n")
+            (SCM obj),
+            "Return @code{#t} if @var{obj} is a pointer object, "
+            "@code{#f} otherwise.\n")
 #define FUNC_NAME s_scm_pointer_p
 {
   return scm_from_bool (SCM_POINTER_P (obj));
@@ -118,11 +118,11 @@ SCM_DEFINE (scm_pointer_p, "pointer?", 1, 0, 0,
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_make_pointer, "make-pointer", 1, 1, 0,
-	    (SCM address, SCM finalizer),
-	    "Return a foreign pointer object pointing to @var{address}. "
-	    "If @var{finalizer} is passed, it should be a pointer to a "
-	    "one-argument C function that will be called when the pointer "
-	    "object becomes unreachable.")
+            (SCM address, SCM finalizer),
+            "Return a foreign pointer object pointing to @var{address}. "
+            "If @var{finalizer} is passed, it should be a pointer to a "
+            "one-argument C function that will be called when the pointer "
+            "object becomes unreachable.")
 #define FUNC_NAME s_scm_make_pointer
 {
   void *c_finalizer;
@@ -170,8 +170,8 @@ scm_from_pointer (void *ptr, scm_t_pointer_finalizer finalizer)
 }
 
 SCM_DEFINE (scm_pointer_address, "pointer-address", 1, 0, 0,
-	    (SCM pointer),
-	    "Return the numerical value of @var{pointer}.")
+            (SCM pointer),
+            "Return the numerical value of @var{pointer}.")
 #define FUNC_NAME s_scm_pointer_address
 {
   SCM_VALIDATE_POINTER (1, pointer);
@@ -181,9 +181,9 @@ SCM_DEFINE (scm_pointer_address, "pointer-address", 1, 0, 0,
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_pointer_to_scm, "pointer->scm", 1, 0, 0,
-	    (SCM pointer),
-	    "Unsafely cast @var{pointer} to a Scheme object.\n"
-	    "Cross your fingers!")
+            (SCM pointer),
+            "Unsafely cast @var{pointer} to a Scheme object.\n"
+            "Cross your fingers!")
 #define FUNC_NAME s_scm_pointer_to_scm
 {
   SCM_VALIDATE_POINTER (1, pointer);
@@ -193,8 +193,8 @@ SCM_DEFINE (scm_pointer_to_scm, "pointer->scm", 1, 0, 0,
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_scm_to_pointer, "scm->pointer", 1, 0, 0,
-	    (SCM scm),
-	    "Return a foreign pointer object with the @code{object-address}\n"
+            (SCM scm),
+            "Return a foreign pointer object with the @code{object-address}\n"
             "of @var{scm}.")
 #define FUNC_NAME s_scm_scm_to_pointer
 {
@@ -209,18 +209,18 @@ SCM_DEFINE (scm_scm_to_pointer, "scm->pointer", 1, 0, 0,
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_pointer_to_bytevector, "pointer->bytevector", 2, 2, 0,
-	    (SCM pointer, SCM len, SCM offset, SCM uvec_type),
-	    "Return a bytevector aliasing the @var{len} bytes pointed\n"
-	    "to by @var{pointer}.\n\n"
+            (SCM pointer, SCM len, SCM offset, SCM uvec_type),
+            "Return a bytevector aliasing the @var{len} bytes pointed\n"
+            "to by @var{pointer}.\n\n"
             "The user may specify an alternate default interpretation for\n"
             "the memory by passing the @var{uvec_type} argument, to indicate\n"
             "that the memory is an array of elements of that type.\n"
             "@var{uvec_type} should be something that\n"
             "@code{uniform-vector-element-type} would return, like @code{f32}\n"
             "or @code{s16}.\n\n"
-	    "When @var{offset} is passed, it specifies the offset in bytes\n"
-	    "relative to @var{pointer} of the memory region aliased by the\n"
-	    "returned bytevector.")
+            "When @var{offset} is passed, it specifies the offset in bytes\n"
+            "relative to @var{pointer} of the memory region aliased by the\n"
+            "returned bytevector.")
 #define FUNC_NAME s_scm_pointer_to_bytevector
 {
   SCM ret;
@@ -273,17 +273,17 @@ SCM_DEFINE (scm_pointer_to_bytevector, "pointer->bytevector", 2, 2, 0,
   blen = scm_to_size_t (len);
 
   ret = scm_c_take_typed_bytevector ((signed char *) ptr + boffset,
-				     blen, btype);
+                                     blen, btype);
   register_weak_reference (ret, pointer);
   return ret;
 }
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_bytevector_to_pointer, "bytevector->pointer", 1, 1, 0,
-	    (SCM bv, SCM offset),
-	    "Return a pointer pointer aliasing the memory pointed to by\n"
+            (SCM bv, SCM offset),
+            "Return a pointer pointer aliasing the memory pointed to by\n"
             "@var{bv} or @var{offset} bytes after @var{bv} when @var{offset}\n"
-	    "is passed.")
+            "is passed.")
 #define FUNC_NAME s_scm_bytevector_to_pointer
 {
   SCM ret;
@@ -337,9 +337,9 @@ scm_i_pointer_print (SCM pointer, SCM port, scm_print_state *pstate)
    (heap allocation overhead, Scheme/C round trips, etc.)  */
 
 SCM_DEFINE (scm_dereference_pointer, "dereference-pointer", 1, 0, 0,
-	    (SCM pointer),
-	    "Assuming @var{pointer} points to a memory region that\n"
-	    "holds a pointer, return this pointer.")
+            (SCM pointer),
+            "Assuming @var{pointer} points to a memory region that\n"
+            "holds a pointer, return this pointer.")
 #define FUNC_NAME s_scm_dereference_pointer
 {
   void **ptr;
@@ -355,9 +355,9 @@ SCM_DEFINE (scm_dereference_pointer, "dereference-pointer", 1, 0, 0,
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_string_to_pointer, "string->pointer", 1, 1, 0,
-	    (SCM string, SCM encoding),
-	    "Return a foreign pointer to a nul-terminated copy of\n"
-	    "@var{string} in the given @var{encoding}, defaulting to\n"
+            (SCM string, SCM encoding),
+            "Return a foreign pointer to a nul-terminated copy of\n"
+            "@var{string} in the given @var{encoding}, defaulting to\n"
             "the current locale encoding.  The C string is freed when\n"
             "the returned foreign pointer becomes unreachable.\n\n"
             "This is the Scheme equivalent of @code{scm_to_stringn}.")
@@ -394,14 +394,14 @@ SCM_DEFINE (scm_string_to_pointer, "string->pointer", 1, 1, 0,
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_pointer_to_string, "pointer->string", 1, 2, 0,
-	    (SCM pointer, SCM length, SCM encoding),
-	    "Return the string representing the C string pointed to by\n"
+            (SCM pointer, SCM length, SCM encoding),
+            "Return the string representing the C string pointed to by\n"
             "@var{pointer}.  If @var{length} is omitted or @code{-1}, the\n"
             "string is assumed to be nul-terminated.  Otherwise\n"
             "@var{length} is the number of bytes in memory pointed to by\n"
             "@var{pointer}.  The C string is assumed to be in the given\n"
             "@var{encoding}, defaulting to the current locale encoding.\n\n"
-	    "This is the Scheme equivalent of @code{scm_from_stringn}.")
+            "This is the Scheme equivalent of @code{scm_from_stringn}.")
 #define FUNC_NAME s_scm_pointer_to_string
 {
   size_t len;
@@ -482,19 +482,19 @@ SCM_DEFINE (scm_alignof, "alignof", 1, 0, 0, (SCM type),
   else if (scm_is_pair (type))
     {
       /* TYPE is a structure.  Section 3-3 of the i386, x86_64, PowerPC,
-	 and SPARC P.S. of the System V ABI all say: "Aggregates
-	 (structures and arrays) and unions assume the alignment of
-	 their most strictly aligned component."  */
+         and SPARC P.S. of the System V ABI all say: "Aggregates
+         (structures and arrays) and unions assume the alignment of
+         their most strictly aligned component."  */
       size_t max;
 
       for (max = 0; scm_is_pair (type); type = SCM_CDR (type))
-	{
-	  size_t align;
+        {
+          size_t align;
 
-	  align = scm_to_size_t (scm_alignof (SCM_CAR (type)));
-	  if (align  > max)
-	    max = align;
-	}
+          align = scm_to_size_t (scm_alignof (SCM_CAR (type)));
+          if (align  > max)
+            max = align;
+        }
 
       return scm_from_size_t (max);
     }
@@ -708,12 +708,12 @@ make_cif (SCM return_type, SCM arg_types, const char *caller)
   /* then ffi_type pointers: one for each arg, one for each struct
      element, and one for each struct (for null-termination) */
   cif_len = (ROUND_UP (cif_len, alignof_type (void *))
-	     + (nargs + n_structs + n_struct_elts)*sizeof(void*));
+             + (nargs + n_structs + n_struct_elts)*sizeof(void*));
 
   /* then the ffi_type structs themselves, one per arg and struct element, and
      one for the return val */
   cif_len = (ROUND_UP (cif_len, alignof_type (ffi_type))
-	     + (nargs + n_struct_elts + 1)*sizeof(ffi_type));
+             + (nargs + n_struct_elts + 1)*sizeof(ffi_type));
 
   mem = scm_gc_malloc_pointerless (cif_len, "foreign");
   /* ensure all the memory is initialized, even the holes */
@@ -724,8 +724,8 @@ make_cif (SCM return_type, SCM arg_types, const char *caller)
   cif_len = ROUND_UP (sizeof (ffi_cif), alignof_type (void *));
   type_ptrs = (ffi_type**)(mem + cif_len);
   cif_len = ROUND_UP (cif_len
-		      + (nargs + n_structs + n_struct_elts)*sizeof(void*),
-		      alignof_type (ffi_type));
+                      + (nargs + n_structs + n_struct_elts)*sizeof(void*),
+                      alignof_type (ffi_type));
   types = (ffi_type*)(mem + cif_len);
 
   /* whew. now knit the pointers together. */
@@ -746,14 +746,21 @@ make_cif (SCM return_type, SCM arg_types, const char *caller)
   cif->flags = 0;
 
   if (FFI_OK != ffi_prep_cif (cif, FFI_DEFAULT_ABI, cif->nargs, cif->rtype,
-			      cif->arg_types))
+                              cif->arg_types))
     SCM_MISC_ERROR ("ffi_prep_cif failed", SCM_EOL);
 
   return cif;
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_pointer_to_procedure, "pointer->procedure", 3, 0, 0,
+static SCM pointer_to_procedure (ffi_cif *cif, SCM func_ptr, SCM return_errno);
+static SCM pointer_to_procedure (ffi_cif *cif, SCM func_ptr, SCM return_errno)
+{
+  return cif_to_procedure (scm_from_pointer (cif, NULL),
+			   func_ptr, return_errno);
+}
+
+SCM_DEFINE (scm_pointer_to_procedure, "pointer->procedure0", 3, 0, 0,
             (SCM return_type, SCM func_ptr, SCM arg_types),
             "Make a foreign function.\n\n"
             "Given the foreign void pointer @var{func_ptr}, its argument and\n"
@@ -770,7 +777,61 @@ SCM_DEFINE (scm_pointer_to_procedure, "pointer->procedure", 3, 0, 0,
 
   cif = make_cif (return_type, arg_types, FUNC_NAME);
 
-  return cif_to_procedure (scm_from_pointer (cif, NULL), func_ptr);
+  return pointer_to_procedure (cif, func_ptr, SCM_BOOL_F);
+}
+#undef FUNC_NAME
+
+SCM_KEYWORD (k_return_errno, "return-errno?");
+
+SCM_DEFINE (scm_i_pointer_to_procedure_with_keywords,
+            "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.\n"
+            "If @var{#:return-errno?} is true, then the @var{errno} will be\n"
+            "returned as the second value.")
+#define FUNC_NAME s_scm_i_pointer_to_procedure_with_keywords
+{
+  ffi_cif *cif;
+  SCM return_errno = SCM_BOOL_F;
+
+  SCM_VALIDATE_POINTER (2, func_ptr);
+
+  scm_c_bind_keyword_arguments (FUNC_NAME, keyword_args, 0,
+                                k_return_errno, &return_errno,
+                                SCM_UNDEFINED);
+
+  cif = make_cif (return_type, arg_types, FUNC_NAME);
+
+  return pointer_to_procedure (cif, func_ptr, return_errno);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_pointer_to_procedure_with_errno,
+	    "pointer->procedure-with-errno", 3, 0, 0,
+	    (SCM return_type, SCM func_ptr, SCM arg_types),
+            "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"
+	    "The errno will be the second value\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_with_errno
+{
+  ffi_cif *cif;
+
+  SCM_VALIDATE_POINTER (2, func_ptr);
+
+  cif = make_cif (return_type, arg_types, FUNC_NAME);
+
+  return pointer_to_procedure (cif, func_ptr, SCM_BOOL_T);
 }
 #undef FUNC_NAME
 
@@ -940,16 +1001,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;
 
+  /* 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));
+
   c_cif = (ffi_cif *) SCM_POINTER_VALUE (cif);
   objcode = get_objcode_trampoline (c_cif->nargs);
   
   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 +1181,12 @@ scm_i_foreign_call (SCM foreign, const SCM *argv)
   unsigned i;
   size_t arg_size;
   scm_t_ptrdiff off;
+  SCM return_errno;
+  int reterr;
 
   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 +1221,21 @@ 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);
-
-  return pack (cif->rtype, rvalue, 1);
+  if (scm_is_true (return_errno))
+    {
+      errno = 0;
+      /* off we go! */
+      ffi_call (cif, func, rvalue, args);
+      reterr = errno;
+      return scm_values (scm_list_2 (pack (cif->rtype, rvalue, 1),
+				     scm_from_int (reterr)));
+    }
+  else
+    {
+      /* off we go! */
+      ffi_call (cif, func, rvalue, args);
+      return pack (cif->rtype, rvalue, 1);
+    }
 }
 
 \f
diff --git a/libguile/foreign.h b/libguile/foreign.h
index 41c0b65..561b9f8 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
@@ -93,9 +93,11 @@ 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 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 arg_types);
 SCM_INTERNAL SCM scm_i_foreign_call (SCM foreign, const SCM *argv);
 
 \f
diff --git a/module/system/foreign.scm b/module/system/foreign.scm
index 55ab014..4436f1f 100644
--- a/module/system/foreign.scm
+++ b/module/system/foreign.scm
@@ -50,6 +50,7 @@
             pointer->string
 
             pointer->procedure
+            pointer->procedure-with-errno
             ;; procedure->pointer (see below)
             make-c-struct parse-c-struct
 
-- 
1.7.10.4

bug#18592: FFI should have portable access to ‘errno’

[Nala Ginrut]

Hi folks!
Is there still any problem with the previous patch?
Could it be applied now?

If anyone think there's problem in it, I'm glad to work for it. Please
don't hesitate to tell, since I need this feature very much.

Thanks!
 

bug#18592: FFI should have portable access to ‘errno’

[Mark H Weaver]

[-- Attachment #1: Type: text/plain, Size: 333 bytes --]

Nala Ginrut <nalaginrut@gmail.com> 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



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH] PRELIMINARY: Add support for errno to Dynamic FFI --]
[-- Type: text/x-patch, Size: 8575 bytes --]

From 17a3ee8c255e06ea7ee805401c94853fb48cbf12 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
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 <alignof.h>
 #include <string.h>
 #include <assert.h>
+#include <errno.h>
 
 #include "libguile/_scm.h"
 #include "libguile/bytevectors.h"
@@ -85,7 +86,7 @@ null_pointer_error (const char *func_name)
 }
 
 \f
-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);
+    }
 }
 
 \f
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

bug#18592: FFI should have portable access to ‘errno’

[Nala Ginrut]

I think it's OK to try this:
(pointer->procedure int (dynamic-func "epoll_create" (dynamic-link)) '()
#:return-errno? #t)

And I'm fine with the patch, could you push it please?

Thank you very much!

On Thu, 2016-02-18 at 08:30 -0500, Mark H Weaver wrote:
> Nala Ginrut <nalaginrut@gmail.com> 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
> 
> 
> differences between files attachment
> (0001-PRELIMINARY-Add-support-for-errno-to-Dynamic-FFI.patch),
> "[PATCH] PRELIMINARY: Add support for errno to Dynamic FFI"
> From 17a3ee8c255e06ea7ee805401c94853fb48cbf12 Mon Sep 17 00:00:00 2001
> From: Mark H Weaver <mhw@netris.org>
> 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 <alignof.h>
>  #include <string.h>
>  #include <assert.h>
> +#include <errno.h>
>  
>  #include "libguile/_scm.h"
>  #include "libguile/bytevectors.h"
> @@ -85,7 +86,7 @@ null_pointer_error (const char *func_name)
>  }
>  
>  \f
> -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);
> +    }
>  }
>  
>  \f
> 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);

bug#18592: FFI should have portable access to ‘errno’

[Nala Ginrut]

Is there still problem? I'm fine with the patch, and I'm expecting to
merge it ASAP. Anyway, please don't hesitate to tell me if there's still
any problem, I'm glad to help to do it better. I really need it.

Thanks! 

On Fri, 2016-02-19 at 13:02 +0800, Nala Ginrut wrote:
> I think it's OK to try this:
> (pointer->procedure int (dynamic-func "epoll_create" (dynamic-link)) '()
> #:return-errno? #t)
> 
> And I'm fine with the patch, could you push it please?
> 
> Thank you very much!
> 
> On Thu, 2016-02-18 at 08:30 -0500, Mark H Weaver wrote:
> > Nala Ginrut <nalaginrut@gmail.com> 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
> > 
> > 
> > differences between files attachment
> > (0001-PRELIMINARY-Add-support-for-errno-to-Dynamic-FFI.patch),
> > "[PATCH] PRELIMINARY: Add support for errno to Dynamic FFI"
> > From 17a3ee8c255e06ea7ee805401c94853fb48cbf12 Mon Sep 17 00:00:00 2001
> > From: Mark H Weaver <mhw@netris.org>
> > 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 <alignof.h>
> >  #include <string.h>
> >  #include <assert.h>
> > +#include <errno.h>
> >  
> >  #include "libguile/_scm.h"
> >  #include "libguile/bytevectors.h"
> > @@ -85,7 +86,7 @@ null_pointer_error (const char *func_name)
> >  }
> >  
> >  \f
> > -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);
> > +    }
> >  }
> >  
> >  \f
> > 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);
> 

bug#18592: FFI should have portable access to ‘errno’

[Mark H Weaver]

Nala Ginrut <nalaginrut@gmail.com> writes:

> Is there still problem? I'm fine with the patch, and I'm expecting to
> merge it ASAP. Anyway, please don't hesitate to tell me if there's still
> any problem, I'm glad to help to do it better. I really need it.

Sorry for the delay, but I'm having second thoughts about whether this
is the right approach.  Perhaps we should instead make a set of
commitments that certain basic operations like scheme evaluation, heap
allocation, and basic scheme procedures will leave 'errno' unchanged.

At the API level, the idea would be that if you write Scheme code that
makes a reasonable effort to avoid non-trivial operations between the
FFI call and the call to (errno) or (set-errno! <n>), this would be
sufficient.

At an implementation level, it would require us to save and restore
'errno' around C library calls that are made by Guile's runtime system
without the user's knowledge, most notably when running GC (during
allocation) or when running asyncs and things like that.

What do you think?

      Mark

bug#18592: FFI should have portable access to ‘errno’

[tomas]

-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

On Thu, Mar 03, 2016 at 12:36:15PM -0500, Mark H Weaver wrote:
> Nala Ginrut <nalaginrut@gmail.com> writes:
> 
> > Is there still problem? I'm fine with the patch, and I'm expecting to
> > merge it ASAP. Anyway, please don't hesitate to tell me if there's still
> > any problem, I'm glad to help to do it better. I really need it.
> 
> Sorry for the delay, but I'm having second thoughts about whether this
> is the right approach.  Perhaps we should instead make a set of
> commitments that certain basic operations like scheme evaluation, heap
> allocation, and basic scheme procedures will leave 'errno' unchanged.

A shout from the peanut gallery (again ;) but this sounds scary. Of course,
clobbering errno by things out of the user's control sounds scary too.
Nala's interface feels to me more... right.

regards
- -- tomás
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.12 (GNU/Linux)

iEYEARECAAYFAlbYn2kACgkQBcgs9XrR2kbhiwCfXq45vAYA5LVcWIcIvyQ1+GKF
ZdwAn2QJVVDz/OoS/NUJ7y6R+GCwdxnc
=xFmg
-----END PGP SIGNATURE-----

bug#18592: FFI should have portable access to ‘errno’

[Nala Ginrut]

hi Mark!
Fairly speaking, your new proposal sounds cool.
But is it necessary to do redundant rework if there's no obvious problem
in the first proposed patch?
Besides, I think the new proposal may introduce extra complexity to
implement. That's what I actually concern about.
IMHO, it is better to avoid introducing more complexities, the simple
way is better for debugging and maintaining.
And it is better for us to have such feature soon, since we need to make
more cool projects to enhance Guile usability in real world.

Anyway, you have the big picture in mind for Guile, maybe you have your
reason for that?

Best regards.


On Thu, 2016-03-03 at 12:36 -0500, Mark H Weaver wrote:
> Nala Ginrut <nalaginrut@gmail.com> writes:
> 
> > Is there still problem? I'm fine with the patch, and I'm expecting to
> > merge it ASAP. Anyway, please don't hesitate to tell me if there's still
> > any problem, I'm glad to help to do it better. I really need it.
> 
> Sorry for the delay, but I'm having second thoughts about whether this
> is the right approach.  Perhaps we should instead make a set of
> commitments that certain basic operations like scheme evaluation, heap
> allocation, and basic scheme procedures will leave 'errno' unchanged.
> 
> At the API level, the idea would be that if you write Scheme code that
> makes a reasonable effort to avoid non-trivial operations between the
> FFI call and the call to (errno) or (set-errno! <n>), this would be
> sufficient.
> 
> At an implementation level, it would require us to save and restore
> 'errno' around C library calls that are made by Guile's runtime system
> without the user's knowledge, most notably when running GC (during
> allocation) or when running asyncs and things like that.
> 
> What do you think?
> 
>       Mark

bug#18592: FFI should have portable access to ‘errno’

[Mark H Weaver]

Mark H Weaver <mhw@netris.org> writes:

> Nala Ginrut <nalaginrut@gmail.com> writes:
>
>> Is there still problem? I'm fine with the patch, and I'm expecting to
>> merge it ASAP. Anyway, please don't hesitate to tell me if there's still
>> any problem, I'm glad to help to do it better. I really need it.
>
> Sorry for the delay, but I'm having second thoughts about whether this
> is the right approach.  Perhaps we should instead make a set of
> commitments that certain basic operations like scheme evaluation, heap
> allocation, and basic scheme procedures will leave 'errno' unchanged.

Okay, I finally decided to go ahead and add 'errno' support to the FFI
directly.  Pushed in commit ee3381c94d389d923591dcb610bac9ecfd68e6a4 to
stable-2.0.  If you could make sure it works for your use cases, I'd be
grateful.

I'm closing this bug now, but feel free to reopen if there are issues.

      Thanks,
        Mark

bug#18592: FFI should have portable access to ‘errno’

[Mark H Weaver]

Hi Nala,

In addition to the API issues raised in my previous mail, the other
problem with this new patch is that it seems that you converted all tabs
to spaces in foreign.c.  Please do not change whitespace in lines that
would otherwise be unchanged by your patch.  I only meant to use spaces
in new lines that you added, but it's not important.

     Thanks,
       Mark

bug#18592: FFI should have portable access to ‘errno’

[Mark H Weaver]

One more thing I forgot to mention: These two commits should be combined
into a single commit.

    Thanks!
      Mark

bug#18592: FFI should have portable access to ‘errno’

[guile]

[-- Attachment #1: Type: text/plain, Size: 477 bytes --]

I'd like to point out that when calling a function that might set errno in C,
it's usually good practice to set errno to zero immediately before the call,
so as to be sure that any subsequent non-zero errno value was actually
a consequence of the function call:
 
errno = 0; /* clear errno before the function call */
rtnval = my_func(...);
if (errno != 0) {...}
 
This should probably be taken into account if you're extending
the FFI to provide access to errno.

[-- Attachment #2: Type: text/html, Size: 564 bytes --]