[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.1-49-g012062a

[Ludovic Courtès]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=012062a0d61cbd297dd58c8168433518c8b450cc

The branch, stable-2.0 has been updated
       via  012062a0d61cbd297dd58c8168433518c8b450cc (commit)
       via  d7fcaec39247b014f3d6aa2ca96a5ff903bc6706 (commit)
      from  cb7523c26db24598fb5aa9138598e1b7a3e6370f (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 012062a0d61cbd297dd58c8168433518c8b450cc
Author: Ludovic Courtès <address@hidden>
Date:   Sun May 8 17:21:59 2011 +0200

    Fix small integer return value packing on big endian machines.
    
    * libguile/foreign.c (pack): Add `return_value_p' parameter.  Update
      callers.
      When RETURN_VALUE_P is true, assume LOC points to an `ffi_arg', and
      cast its results to the relevant type.  This fixes packing of integer
      return values smaller than `int' on SPARC64 and PowerPC64.  Reported
      by Nelson H. F. Beebe <address@hidden>.

commit d7fcaec39247b014f3d6aa2ca96a5ff903bc6706
Author: Ludovic Courtès <address@hidden>
Date:   Sun May 8 16:25:01 2011 +0200

    Make the definition of `scm_read_shebang' match its declaration.
    
    * libguile/read.c (scm_read_shebang): Remove the `inline' keyword.

-----------------------------------------------------------------------

Summary of changes:
 libguile/foreign.c |   49 +++++++++++++++++++++++++++++++++++++++----------
 libguile/read.c    |    2 +-
 2 files changed, 40 insertions(+), 11 deletions(-)

diff --git a/libguile/foreign.c b/libguile/foreign.c
index ae9e27a..68e0efa 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -965,9 +965,12 @@ unpack (const ffi_type *type, void *loc, SCM x)
 }
 #undef FUNC_NAME
 
-/* Return a Scheme representation of the foreign value at LOC of type TYPE.  */
+/* Return a Scheme representation of the foreign value at LOC of type
+   TYPE.  When RETURN_VALUE_P is true, LOC is assumed to point to a
+   return value buffer; otherwise LOC is assumed to point to an
+   argument buffer.  */
 static SCM
-pack (const ffi_type * type, const void *loc)
+pack (const ffi_type * type, const void *loc, int return_value_p)
 {
   switch (type->type)
     {
@@ -977,22 +980,48 @@ pack (const ffi_type * type, const void *loc)
       return scm_from_double (*(float *) loc);
     case FFI_TYPE_DOUBLE:
       return scm_from_double (*(double *) loc);
+
+      /* For integer return values smaller than `int', libffi stores the
+        result in an `ffi_arg'-long buffer, of which only the
+        significant bits must be kept---hence the pair of casts below.
+        See <http://thread.gmane.org/gmane.comp.lib.ffi.general/406>
+        for details.  */
+
     case FFI_TYPE_UINT8:
-      return scm_from_uint8 (*(scm_t_uint8 *) loc);
+      if (return_value_p)
+       return scm_from_uint8 ((scm_t_uint8) *(ffi_arg *) loc);
+      else
+       return scm_from_uint8 (* (scm_t_uint8 *) loc);
     case FFI_TYPE_SINT8:
-      return scm_from_int8 (*(scm_t_int8 *) loc);
+      if (return_value_p)
+       return scm_from_int8 ((scm_t_int8) *(ffi_arg *) loc);
+      else
+       return scm_from_int8 (* (scm_t_int8 *) loc);
     case FFI_TYPE_UINT16:
-      return scm_from_uint16 (*(scm_t_uint16 *) loc);
+      if (return_value_p)
+       return scm_from_uint16 ((scm_t_uint16) *(ffi_arg *) loc);
+      else
+       return scm_from_uint16 (* (scm_t_uint16 *) loc);
     case FFI_TYPE_SINT16:
-      return scm_from_int16 (*(scm_t_int16 *) loc);
+      if (return_value_p)
+       return scm_from_int16 ((scm_t_int16) *(ffi_arg *) loc);
+      else
+       return scm_from_int16 (* (scm_t_int16 *) loc);
     case FFI_TYPE_UINT32:
-      return scm_from_uint32 (*(scm_t_uint32 *) loc);
+      if (return_value_p)
+       return scm_from_uint32 ((scm_t_uint32) *(ffi_arg *) loc);
+      else
+       return scm_from_uint32 (* (scm_t_uint32 *) loc);
     case FFI_TYPE_SINT32:
-      return scm_from_int32 (*(scm_t_int32 *) loc);
+      if (return_value_p)
+       return scm_from_int32 ((scm_t_int32) *(ffi_arg *) loc);
+      else
+       return scm_from_int32 (* (scm_t_int32 *) loc);
     case FFI_TYPE_UINT64:
       return scm_from_uint64 (*(scm_t_uint64 *) loc);
     case FFI_TYPE_SINT64:
       return scm_from_int64 (*(scm_t_int64 *) loc);
+
     case FFI_TYPE_STRUCT:
       {
        void *mem = scm_gc_malloc_pointerless (type->size, "foreign");
@@ -1060,7 +1089,7 @@ scm_i_foreign_call (SCM foreign, const SCM *argv)
   /* off we go! */
   ffi_call (cif, func, rvalue, args);
 
-  return pack (cif->rtype, rvalue);
+  return pack (cif->rtype, rvalue, 1);
 }
 
 
@@ -1082,7 +1111,7 @@ invoke_closure (ffi_cif *cif, void *ret, void **args, 
void *data)
 
   /* Pack ARGS to SCM values, setting ARGV pointers.  */
   for (i = 0; i < cif->nargs; i++)
-    argv[i] = pack (cif->arg_types[i], args[i]);
+    argv[i] = pack (cif->arg_types[i], args[i], 0);
 
   result = scm_call_n (proc, argv, cif->nargs);
 
diff --git a/libguile/read.c b/libguile/read.c
index b36c27c..676ccf7 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -1135,7 +1135,7 @@ scm_read_scsh_block_comment (scm_t_wchar chr, SCM port)
   return SCM_UNSPECIFIED;
 }
 
-static inline SCM
+static SCM
 scm_read_shebang (scm_t_wchar chr, SCM port)
 {
   int c = 0;


hooks/post-receive
-- 
GNU Guile