>From 88a99af4b5db9096c3cde51c72eb371b6be76754 Mon Sep 17 00:00:00 2001
From: Nala Ginrut <address@hidden>
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)
 }
 
 
-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