[Guile-commits] GNU Guile branch, master, updated. release_1-9-10-223-g715416f

[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=715416f68d0971fc03b7fca654c046b10e5df43b

The branch, master has been updated
       via  715416f68d0971fc03b7fca654c046b10e5df43b (commit)
       via  8b8ce935ed6e9d15e260ddbf52c2b29822108f2e (commit)
       via  86425e26539fc1ffc145f74730c846cb724179a6 (commit)
       via  1880c97df10770eba8dbf1f068903e713dbf3f7e (commit)
       via  fd449a269050b50cb639f695508bf2859a30841b (commit)
      from  db10a69bf4f8440b783147d3b3fac8bcaec57e5d (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 715416f68d0971fc03b7fca654c046b10e5df43b
Author: Ludovic Courtès <address@hidden>
Date:   Sun May 30 22:56:58 2010 +0200

    Ignore `.version'.

commit 8b8ce935ed6e9d15e260ddbf52c2b29822108f2e
Author: Ludovic Courtès <address@hidden>
Date:   Sun May 30 22:56:17 2010 +0200

    Have `test-ffi' run all the tests even after a failure.
    
    * test-suite/standalone/test-ffi (failed?): New variable.
      (test): Set `failed?' to #t upon error and display an error message.
      Have the exit code depend on FAILED?.

commit 86425e26539fc1ffc145f74730c846cb724179a6
Author: Ludovic Courtès <address@hidden>
Date:   Sun May 30 22:54:39 2010 +0200

    Fix argument and return value alignment in `scm_i_foreign_call'.
    
    * libguile/foreign.c (scm_i_foreign_call): Fix the computation of
      ARG_SIZE wrt. alignment.  Arrange so that the address ARGS[i] is
      aligned, rather than checking whether OFF is aligned.  Have the RVALUE
      be at least word-aligned, which fixes calls to `char'-returning
      functions on `armv5tel-*-linux-gnueabi'.

commit 1880c97df10770eba8dbf1f068903e713dbf3f7e
Author: Ludovic Courtès <address@hidden>
Date:   Sun May 30 22:41:36 2010 +0200

    Fix parenthesizing of the `ROUND_UP' macro; factorize.
    
    * libguile/_scm.h (ROUND_UP): New macro.
    
    * libguile/continuations.c (ROUND_UP): Remove.
    
    * libguile/control.c (ROUND_UP): Remove.
    
    * libguile/foreign.c (ROUND_UP): Remove.

commit fd449a269050b50cb639f695508bf2859a30841b
Author: Ludovic Courtès <address@hidden>
Date:   Sun May 30 22:39:23 2010 +0200

    Relax the `(version)' test.
    
    * test-suite/tests/version.test ("version reporting works"): Test
      whether `(version)' contains MAJOR.MINOR.MICRO, rather than being
      equal to it.

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

Summary of changes:
 .gitignore                     |    1 +
 libguile/_scm.h                |    4 ++++
 libguile/continuations.c       |    1 -
 libguile/control.c             |    1 -
 libguile/foreign.c             |   40 +++++++++++++++++++++-------------------
 test-suite/standalone/test-ffi |   12 ++++++++++--
 test-suite/tests/version.test  |   13 +++++++------
 7 files changed, 43 insertions(+), 29 deletions(-)

diff --git a/.gitignore b/.gitignore
index b07b196..db02d0f 100644
--- a/.gitignore
+++ b/.gitignore
@@ -127,3 +127,4 @@ INSTALL
 /lib/sys/socket.h
 /lib/warn-on-use.h
 /lib/unused-parameter.h
+/.version
diff --git a/libguile/_scm.h b/libguile/_scm.h
index 9cd6fad..bf655b3 100644
--- a/libguile/_scm.h
+++ b/libguile/_scm.h
@@ -118,6 +118,10 @@
 #define max(A, B) ((A) >= (B) ? (A) : (B))
 #endif
 
+/* Return the first integer greater than or equal to LEN such that
+   LEN % ALIGN == 0.  Return LEN if ALIGN is zero.  */
+#define ROUND_UP(len, align)                                   \
+  ((align) ? (((len) - 1UL) | ((align) - 1UL)) + 1UL : (len))
 
 
 #if GUILE_USE_64_CALLS && defined(HAVE_STAT64)
diff --git a/libguile/continuations.c b/libguile/continuations.c
index 69a87d2..dc504f0 100644
--- a/libguile/continuations.c
+++ b/libguile/continuations.c
@@ -71,7 +71,6 @@ static scm_t_bits tc16_continuation;
 #define META_HEADER(meta)         meta, 0, 0, 0, 0,      0, 0, 0
 #endif
 
-#define ROUND_UP(len,align) (((len-1)|(align-1))+1)
 #define ALIGN_PTR(type,p,align) (type*)(ROUND_UP (((scm_t_bits)p), align))
 
 #ifdef SCM_ALIGNED
diff --git a/libguile/control.c b/libguile/control.c
index bb35fdf..6c20675 100644
--- a/libguile/control.c
+++ b/libguile/control.c
@@ -79,7 +79,6 @@ scm_i_prompt_pop_abort_args_x (SCM prompt)
 #define META_HEADER(meta)         meta, 0, 0, 0, 0,      0, 0, 0
 #endif
 
-#define ROUND_UP(len,align) (((len-1)|(align-1))+1)
 #define ALIGN_PTR(type,p,align) (type*)(ROUND_UP (((scm_t_bits)p), align))
 
 #ifdef SCM_ALIGNED
diff --git a/libguile/foreign.c b/libguile/foreign.c
index a58634a..aae4c67 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -24,6 +24,8 @@
 
 #include <alignof.h>
 #include <string.h>
+#include <assert.h>
+
 #include "libguile/_scm.h"
 #include "libguile/bytevectors.h"
 #include "libguile/instructions.h"
@@ -431,9 +433,6 @@ scm_i_foreign_print (SCM foreign, SCM port, scm_print_state 
*pstate)
 
 
 
-
-#define ROUND_UP(len,align) (align?(((len-1)|(align-1))+1):len)
-
 SCM_DEFINE (scm_alignof, "alignof", 1, 0, 0, (SCM type),
             "Return the alignment of @var{type}, in bytes.\n\n"
             "@var{type} should be a valid C type, like @code{int}.\n"
@@ -988,32 +987,35 @@ scm_i_foreign_call (SCM foreign, const SCM *argv)
   /* Argument pointers.  */
   args = alloca (sizeof (void *) * cif->nargs);
 
-  /* Compute the amount of memory needed to store all the argument values.
-     Note: as of libffi 3.0.9 `cif->bytes' is undocumented and is zero, so it
-     can't be used for that purpose.  */
-  for (i = 0, arg_size = 0;
-       i < cif->nargs;
-       i++, arg_size)
-    arg_size += ROUND_UP (cif->arg_types[i]->size,
-                         cif->arg_types[i]->alignment);
+  /* Compute the worst-case amount of memory needed to store all the argument
+     values.  Note: as of libffi 3.0.9 `cif->bytes' is undocumented and is 
zero,
+     so it can't be used for that purpose.  */
+  for (i = 0, arg_size = 0; i < cif->nargs; i++)
+    arg_size += cif->arg_types[i]->size + cif->arg_types[i]->alignment - 1;
 
   /* Space for argument values, followed by return value.  */
-  data = alloca (arg_size
-                + ROUND_UP (cif->rtype->size, cif->rtype->alignment));
+  data = alloca (arg_size + cif->rtype->size
+                + max (sizeof (void *), cif->rtype->alignment));
 
   /* Unpack ARGV to native values, setting ARGV pointers.  */
   for (i = 0, off = 0;
        i < cif->nargs;
-       off += cif->arg_types[i]->size, i++)
+       off = (scm_t_uint8 *) args[i] - data + cif->arg_types[i]->size,
+        i++)
     {
-      off = ROUND_UP (off, cif->arg_types[i]->alignment);
-      args[i] = data + off;
+      /* Suitably align the storage area for argument I.  */
+      args[i] = (void *) ROUND_UP ((scm_t_uintptr) data + off,
+                                  cif->arg_types[i]->alignment);
+      assert ((scm_t_uintptr) args[i] % cif->arg_types[i]->alignment == 0);
       unpack (cif->arg_types[i], args[i], argv[i]);
     }
 
-  /* Prepare space for the return value.  */
-  off = ROUND_UP (off, cif->rtype->alignment);
-  rvalue = data + off;
+  /* Prepare space for the return value.  On some platforms, such as
+     `armv5tel-*-linux-gnueabi', the return value has to be at least
+     word-aligned, even if its type doesn't have any alignment requirement as 
is
+     the case with `char'.  */
+  rvalue = (void *) ROUND_UP ((scm_t_uintptr) data + off,
+                             max (sizeof (void *), cif->rtype->alignment));
 
   /* off we go! */
   ffi_call (cif, func, rvalue, args);
diff --git a/test-suite/standalone/test-ffi b/test-suite/standalone/test-ffi
index 19c1c15..debe4e1 100755
--- a/test-suite/standalone/test-ffi
+++ b/test-suite/standalone/test-ffi
@@ -8,13 +8,19 @@ exec guile -q -s "$0" "$@"
 (define lib
   (dynamic-link (string-append (getenv "builddir") "/libtest-ffi")))
 
+(define failed? #f)
+
 (define-syntax test
   (syntax-rules ()
     ((_ exp res)
      (let ((expected res)
            (actual exp))
        (if (not (equal? actual expected))
-           (error "Bad return from expression" 'exp actual expected))))))
+           (begin
+             (set! failed? #t)
+             (format (current-error-port)
+                     "bad return from expression `~a': expected ~A; got ~A~%"
+                     'exp expected actual)))))))
 
 ;;;
 ;;; No args
@@ -194,6 +200,8 @@ exec guile -q -s "$0" "$@"
        (str (utf8->string bv)))
   (test #t (not (not (string-contains str "file")))))
 
+(exit (not failed?))
+
 ;; Local Variables:
 ;; mode: scheme
-;; End:
\ No newline at end of file
+;; End:
diff --git a/test-suite/tests/version.test b/test-suite/tests/version.test
index 1789287..c1ce395 100644
--- a/test-suite/tests/version.test
+++ b/test-suite/tests/version.test
@@ -1,4 +1,4 @@
-;;;; versions.test --- test suite for Guile's version functions  -*- scheme -*-
+;;;; version.test --- test suite for Guile's version functions  -*- scheme -*-
 ;;;; Greg J. Badros <address@hidden>
 ;;;;
 ;;;;   Copyright (C) 2000, 2001, 2006, 2010 Free Software Foundation, Inc.
@@ -17,13 +17,14 @@
 ;;;; License along with this library; if not, write to the Free Software
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 
USA
 
-(use-modules (test-suite lib))
+(define-module (test-version)
+  #:use-module (test-suite lib))
 
 (pass-if "version reporting works"
         (and (string? (major-version))
              (string? (minor-version))
              (string? (micro-version))
-             (string=? (version)
-                       (string-append (major-version) "."
-                                      (minor-version) "."
-                                      (micro-version)))))
+             (string-contains (version)
+                               (string-append (major-version) "."
+                                              (minor-version) "."
+                                              (micro-version)))))


hooks/post-receive
-- 
GNU Guile