[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. release_1-9-13-77-g0b
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-13-77-g0b54eea |
|
Date: |
Fri, 19 Nov 2010 12:44:57 +0000 |
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=0b54eea09a4c975931386a34c53711393b1f7c75
The branch, master has been updated
via 0b54eea09a4c975931386a34c53711393b1f7c75 (commit)
via 2427baa6a21925178f99726083e38d53b2276b9b (commit)
via 0c57673a1176dec03d6ddb88fa5cfc82a2628cc3 (commit)
via f13f1e9f6ff111fa676e54090eb62f2a0f066d13 (commit)
via fb032fa722d81f575169e3be5623ebb761f28da0 (commit)
via 553d4bf8ea4ca1f844e9f2dd7edcc2ce4ee9fe62 (commit)
from c9b16ceef7fe382aef3c4d236bdc83901d55d18d (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 0b54eea09a4c975931386a34c53711393b1f7c75
Author: Ludovic Courtès <address@hidden>
Date: Fri Nov 19 11:18:42 2010 +0100
Optimize fixnum comparison.
* libguile/vm-i-scheme.c (REL): Don't untag X and Y since tagging
preserves ordering.
commit 2427baa6a21925178f99726083e38d53b2276b9b
Author: Ludovic Courtès <address@hidden>
Date: Fri Nov 19 11:06:10 2010 +0100
Add fixnum arithmetic benchmarks.
* benchmark-suite/benchmarks/arithmetic.bm ("fixnum")["*", "/"]: New
benchmarks.
commit 0c57673a1176dec03d6ddb88fa5cfc82a2628cc3
Author: Ludovic Courtès <address@hidden>
Date: Wed Nov 17 23:06:26 2010 +0100
Add optimized tagged integer addition/subtractions for x86_64.
This results in a 17% improvement in the execution time of the "+" and
"-" benchmarks for fixnums.
* libguile/vm-i-scheme.c (ASM_ADD, ASM_SUB)[defined __x86_64__ &&
SCM_GNUC_PREREQ (4, 5)]: New macros.
(add)[defined ASM_ADD]: Use `ASM_ADD' for the fast path.
(sub)[defined ASM_SUB]: Use `ASM_SUB' for the fast path.
* test-suite/tests/numbers.test ("+")["fixnum + fixnum = bignum
(32-bit)", "fixnum + fixnum = bignum (64-bit)", "bignum + fixnum =
fixnum", "wrong type"]: New tests.
("-")["fixnum - fixnum = bignum (32-bit)", "fixnum - fixnum = bignum
(64-bit)", "bignum - fixnum = fixnum", "wrong type"]: New tests.
* test-suite/tests/00-initial-env.test ("goopsless")["+ wrong type
argument"]: Use `with-test-prefix/c&e' instead of `with-test-prefix'.
["- wrong type argument"]: New test prefix.
commit f13f1e9f6ff111fa676e54090eb62f2a0f066d13
Author: Ludovic Courtès <address@hidden>
Date: Wed Nov 17 23:05:50 2010 +0100
Use the `with-test-prefix/c&e' for the `1+' and `1-' tests.
* test-suite/tests/numbers.test ("1+"): Use `with-test-prefix/c&e'
instead of `with-test-prefix'. Provide a name to each `pass-if'
invocation.
("1-"): Likewise.
commit fb032fa722d81f575169e3be5623ebb761f28da0
Author: Ludovic Courtès <address@hidden>
Date: Wed Nov 17 23:04:11 2010 +0100
Move `with-test-prefix/c&e' to `(test-suite lib)'.
* test-suite/tests/bytevectors.test (c&e, with-test-prefix/c&e): Move...
* test-suite/lib.scm: ... here.
(with-test-prefix): Rewrite using `syntax-rules'.
commit 553d4bf8ea4ca1f844e9f2dd7edcc2ce4ee9fe62
Author: Ludovic Courtès <address@hidden>
Date: Fri Nov 12 09:54:49 2010 +0100
Add `SCM_GNUC_PREREQ'.
* libguile/__scm.h (SCM_GNUC_PREREQ): New macro.
Use it in this file in lieu of hand-written GCC version tests.
-----------------------------------------------------------------------
Summary of changes:
benchmark-suite/benchmarks/arithmetic.bm | 8 +++-
libguile/__scm.h | 16 +++++--
libguile/vm-i-scheme.c | 78 ++++++++++++++++++++++++++++-
test-suite/lib.scm | 43 ++++++++++++++---
test-suite/tests/00-initial-env.test | 16 +++++-
test-suite/tests/bytevectors.test | 20 --------
test-suite/tests/numbers.test | 62 +++++++++++++++++-------
7 files changed, 188 insertions(+), 55 deletions(-)
diff --git a/benchmark-suite/benchmarks/arithmetic.bm
b/benchmark-suite/benchmarks/arithmetic.bm
index 62d67be..0755c03 100644
--- a/benchmark-suite/benchmarks/arithmetic.bm
+++ b/benchmark-suite/benchmarks/arithmetic.bm
@@ -58,4 +58,10 @@
(repeat (+ 2 <>) 7 100))
(benchmark "-" 1e7
- (repeat (+ 2 <>) 7 100)))
+ (repeat (+ 2 <>) 7 100))
+
+ (benchmark "*" 1e7
+ (repeat (* 1 <>) 1 100))
+
+ (benchmark "/" 1e7
+ (repeat (/ 2 <>) 1 100)))
diff --git a/libguile/__scm.h b/libguile/__scm.h
index 12d1e8a..efdab6d 100644
--- a/libguile/__scm.h
+++ b/libguile/__scm.h
@@ -62,6 +62,15 @@
* additional information to the developers.
*/
+/* Return true (non-zero) if GCC version MAJ.MIN or later is being used
+ * (macro taken from glibc.) */
+#if defined __GNUC__ && defined __GNUC_MINOR__
+# define SCM_GNUC_PREREQ(maj, min) \
+ ((__GNUC__ << 16) + __GNUC_MINOR__ >= ((maj) << 16) + (min))
+#else
+# define SCM_GNUC_PREREQ(maj, min) 0
+#endif
+
/* The macro SCM_NORETURN indicates that a function will never return.
* Examples:
* 1) int foo (char arg) SCM_NORETURN;
@@ -89,7 +98,7 @@
/* The SCM_EXPECT macros provide branch prediction hints to the compiler. To
* use only in places where the result of the expression under "normal"
* circumstances is known. */
-#if defined(__GNUC__) && (__GNUC__ >= 3)
+#if SCM_GNUC_PREREQ (3, 0)
# define SCM_EXPECT __builtin_expect
#else
# define SCM_EXPECT(_expr, _value) (_expr)
@@ -108,8 +117,7 @@
* or variables. Defining `SCM_BUILDING_DEPRECATED_CODE' allows deprecated
* functions to be implemented in terms of deprecated functions, and allows
* deprecated functions to be referred to by `scm_c_define_gsubr ()'. */
-#if !defined (SCM_BUILDING_DEPRECATED_CODE) \
- && defined (__GNUC__) && (__GNUC__ >= 3)
+#if !defined (SCM_BUILDING_DEPRECATED_CODE) && SCM_GNUC_PREREQ (3, 0)
# define SCM_DEPRECATED SCM_API __attribute__ ((__deprecated__))
#else
# define SCM_DEPRECATED SCM_API
@@ -129,7 +137,7 @@
/* The SCM_MALLOC macro can be used in function declarations to tell the
* compiler that a function may be treated as if any non-NULL pointer it
returns
* cannot alias any other pointer valid when the function returns. */
-#if defined (__GNUC__) && (__GNUC__ >= 3)
+#if SCM_GNUC_PREREQ (3, 0)
# define SCM_MALLOC __attribute__ ((__malloc__))
#else
# define SCM_MALLOC
diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c
index 3e80a0e..ec22673 100644
--- a/libguile/vm-i-scheme.c
+++ b/libguile/vm-i-scheme.c
@@ -174,9 +174,10 @@ VM_DEFINE_INSTRUCTION (144, set_cdr, "set-cdr!", 0, 2, 0)
{ \
ARGS2 (x, y); \
if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \
- RETURN (scm_from_bool (SCM_I_INUM (x) crel SCM_I_INUM (y))); \
- SYNC_REGISTER (); \
- RETURN (srel (x, y)); \
+ RETURN (scm_from_bool ((scm_t_signed_bits) (x) \
+ crel (scm_t_signed_bits) (y))); \
+ SYNC_REGISTER (); \
+ RETURN (srel (x, y)); \
}
VM_DEFINE_FUNCTION (145, ee, "ee?", 2)
@@ -210,6 +211,8 @@ VM_DEFINE_FUNCTION (149, ge, "ge?", 2)
*/
/* The maximum/minimum tagged integers. */
+#undef INUM_MAX
+#undef INUM_MIN
#define INUM_MAX (INTPTR_MAX - 1)
#define INUM_MIN (INTPTR_MIN + scm_tc2_int)
@@ -227,9 +230,68 @@ VM_DEFINE_FUNCTION (149, ge, "ge?", 2)
RETURN (SFUNC (x, y)); \
}
+/* Assembly tagged integer arithmetic routines. This code uses the
+ `asm goto' feature introduced in GCC 4.5. */
+
+#if defined __x86_64__ && SCM_GNUC_PREREQ (4, 5)
+
+/* The macros below check the CPU's overflow flag to improve fixnum
+ arithmetic. The %rcx register is explicitly clobbered because `asm
+ goto' can't have outputs, in which case the `r' constraint could be
+ used to let the register allocator choose a register.
+
+ TODO: Use `cold' label attribute in GCC 4.6.
+ http://gcc.gnu.org/ml/gcc-patches/2010-10/msg01777.html */
+
+# define ASM_ADD(x, y) \
+ { \
+ asm volatile goto ("mov %1, %%rcx; " \
+ "test %[tag], %%cl; je %l[slow_add]; " \
+ "test %[tag], %0; je %l[slow_add]; " \
+ "add %0, %%rcx; jo %l[slow_add]; " \
+ "sub %[tag], %%rcx; " \
+ "mov %%rcx, (%[vsp])\n" \
+ : /* no outputs */ \
+ : "r" (x), "r" (y), \
+ [vsp] "r" (sp), [tag] "i" (scm_tc2_int) \
+ : "rcx", "memory" \
+ : slow_add); \
+ NEXT; \
+ } \
+ slow_add: \
+ do { } while (0)
+
+# define ASM_SUB(x, y) \
+ { \
+ asm volatile goto ("mov %0, %%rcx; " \
+ "test %[tag], %%cl; je %l[slow_sub]; " \
+ "test %[tag], %1; je %l[slow_sub]; " \
+ "sub %1, %%rcx; jo %l[slow_sub]; " \
+ "add %[tag], %%rcx; " \
+ "mov %%rcx, (%[vsp])\n" \
+ : /* no outputs */ \
+ : "r" (x), "r" (y), \
+ [vsp] "r" (sp), [tag] "i" (scm_tc2_int) \
+ : "rcx", "memory" \
+ : slow_sub); \
+ NEXT; \
+ } \
+ slow_sub: \
+ do { } while (0)
+
+#endif
+
+
VM_DEFINE_FUNCTION (150, add, "add", 2)
{
+#ifndef ASM_ADD
FUNC2 (+, scm_sum);
+#else
+ ARGS2 (x, y);
+ ASM_ADD (x, y);
+ SYNC_REGISTER ();
+ RETURN (scm_sum (x, y));
+#endif
}
VM_DEFINE_FUNCTION (151, add1, "add1", 1)
@@ -256,7 +318,14 @@ VM_DEFINE_FUNCTION (151, add1, "add1", 1)
VM_DEFINE_FUNCTION (152, sub, "sub", 2)
{
+#ifndef ASM_SUB
FUNC2 (-, scm_difference);
+#else
+ ARGS2 (x, y);
+ ASM_SUB (x, y);
+ SYNC_REGISTER ();
+ RETURN (scm_difference (x, y));
+#endif
}
VM_DEFINE_FUNCTION (153, sub1, "sub1", 1)
@@ -281,6 +350,9 @@ VM_DEFINE_FUNCTION (153, sub1, "sub1", 1)
RETURN (scm_difference (x, SCM_I_MAKINUM (1)));
}
+# undef ASM_ADD
+# undef ASM_SUB
+
VM_DEFINE_FUNCTION (154, mul, "mul", 2)
{
ARGS2 (x, y);
diff --git a/test-suite/lib.scm b/test-suite/lib.scm
index 13a268a..8ebcb01 100644
--- a/test-suite/lib.scm
+++ b/test-suite/lib.scm
@@ -17,10 +17,11 @@
;;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (test-suite lib)
- :use-module (ice-9 stack-catch)
- :use-module (ice-9 regex)
- :autoload (srfi srfi-1) (append-map)
- :export (
+ #:use-module (ice-9 stack-catch)
+ #:use-module (ice-9 regex)
+ #:autoload (srfi srfi-1) (append-map)
+ #:autoload (system base compile) (compile)
+ #:export (
;; Exceptions which are commonly being tested for.
exception:syntax-pattern-unmatched
@@ -45,7 +46,10 @@
pass-if-exception expect-fail-exception
;; Naming groups of tests in a regular fashion.
- with-test-prefix with-test-prefix* current-test-prefix
+ with-test-prefix
+ with-test-prefix*
+ with-test-prefix/c&e
+ current-test-prefix
format-test-name
;; Using the debugging evaluator.
@@ -438,8 +442,33 @@
;;; The name prefix is only changed within the dynamic scope of the
;;; with-test-prefix expression. Return the value returned by the last
;;; BODY expression.
-(defmacro with-test-prefix (prefix . body)
- `(with-test-prefix* ,prefix (lambda () ,@body)))
+(define-syntax with-test-prefix
+ (syntax-rules ()
+ ((_ prefix body ...)
+ (with-test-prefix* prefix (lambda () body ...)))))
+
+(define-syntax c&e
+ (syntax-rules (pass-if pass-if-exception)
+ "Run the given tests both with the evaluator and the compiler/VM."
+ ((_ (pass-if test-name exp))
+ (begin (pass-if (string-append test-name " (eval)")
+ (primitive-eval 'exp))
+ (pass-if (string-append test-name " (compile)")
+ (compile 'exp #:to 'value #:env (current-module)))))
+ ((_ (pass-if-exception test-name exc exp))
+ (begin (pass-if-exception (string-append test-name " (eval)")
+ exc (primitive-eval 'exp))
+ (pass-if-exception (string-append test-name " (compile)")
+ exc (compile 'exp #:to 'value
+ #:env (current-module)))))))
+
+;;; (with-test-prefix/c&e PREFIX BODY ...)
+;;; Same as `with-test-prefix', but the enclosed tests are run both with
+;;; the compiler/VM and the evaluator.
+(define-syntax with-test-prefix/c&e
+ (syntax-rules ()
+ ((_ section-name exp ...)
+ (with-test-prefix section-name (c&e exp) ...))))
;;; Call THUNK using the debugging evaluator.
(define (with-debugging-evaluator* thunk)
diff --git a/test-suite/tests/00-initial-env.test
b/test-suite/tests/00-initial-env.test
index 3b3fe3a..c57079e 100644
--- a/test-suite/tests/00-initial-env.test
+++ b/test-suite/tests/00-initial-env.test
@@ -29,7 +29,7 @@
(with-test-prefix "goopsless"
- (with-test-prefix "+ wrong type argument"
+ (with-test-prefix/c&e "+ wrong type argument"
;; The following tests assume that `+' hasn't been turned into a generic
;; and extended. Since the ECMAScript run-time library does exactly
@@ -45,4 +45,16 @@
(pass-if-exception "implicit forcing is not supported"
exception:wrong-type-arg
- (+ (delay (* 3 7)) 13))))
+ (+ (delay (* 3 7)) 13)))
+
+ (with-test-prefix/c&e "- wrong type argument"
+
+ ;; Same for `-'.
+
+ (pass-if-exception "1st argument string"
+ exception:wrong-type-arg
+ (+ "1" 2))
+
+ (pass-if-exception "2nd argument symbol"
+ exception:wrong-type-arg
+ (+ 1 'bar))))
diff --git a/test-suite/tests/bytevectors.test
b/test-suite/tests/bytevectors.test
index 68523b7..081e4ee 100644
--- a/test-suite/tests/bytevectors.test
+++ b/test-suite/tests/bytevectors.test
@@ -25,26 +25,6 @@
;;; Some of the tests in here are examples taken from the R6RS Standard
;;; Libraries document.
-(define-syntax c&e
- (syntax-rules (pass-if pass-if-exception)
- ((_ (pass-if test-name exp))
- (begin (pass-if (string-append test-name " (eval)")
- (primitive-eval 'exp))
- (pass-if (string-append test-name " (compile)")
- (compile 'exp #:to 'value #:env (current-module)))))
- ((_ (pass-if-exception test-name exc exp))
- (begin (pass-if-exception (string-append test-name " (eval)")
- exc (primitive-eval 'exp))
- (pass-if-exception (string-append test-name " (compile)")
- exc (compile 'exp #:to 'value
- #:env (current-module)))))))
-
-(define-syntax with-test-prefix/c&e
- (syntax-rules ()
- ((_ section-name exp ...)
- (with-test-prefix section-name (c&e exp) ...))))
-
-
(with-test-prefix/c&e "2.2 General Operations"
diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index 43a1a90..b365c64 100644
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -101,41 +101,45 @@
;;; 1+
;;;
-(with-test-prefix "1+"
+(with-test-prefix/c&e "1+"
(pass-if "documented?"
(documented? 1+))
- (pass-if (eqv? 1 (1+ 0)))
- (pass-if (eqv? 0 (1+ -1)))
- (pass-if (eqv? 101 (1+ 100)))
- (pass-if (eqv? -99 (1+ -100)))
+ (pass-if "0" (eqv? 1 (1+ 0)))
+ (pass-if "-1" (eqv? 0 (1+ -1)))
+ (pass-if "100" (eqv? 101 (1+ 100)))
+ (pass-if "-100" (eqv? -99 (1+ -100)))
;; The maximum fixnum on a 32-bit architecture: 2^29 - 1.
- (pass-if (eqv? 536870912 (1+ 536870911)))
+ (pass-if "1+ fixnum = bignum (32-bit)"
+ (eqv? 536870912 (1+ 536870911)))
;; The maximum fixnum on a 64-bit architecture: 2^61 - 1.
- (pass-if (eqv? 2305843009213693952 (1+ 2305843009213693951))))
+ (pass-if "1+ fixnum = bignum (64-bit)"
+ (eqv? 2305843009213693952 (1+ 2305843009213693951))))
;;;
;;; 1-
;;;
-(with-test-prefix "1-"
+(with-test-prefix/c&e "1-"
(pass-if "documented?"
(documented? 1-))
- (pass-if (eqv? -1 (1- 0)))
- (pass-if (eqv? 0 (1- 1)))
- (pass-if (eqv? 99 (1- 100)))
- (pass-if (eqv? -101 (1- -100)))
+ (pass-if "0" (eqv? -1 (1- 0)))
+ (pass-if "1" (eqv? 0 (1- 1)))
+ (pass-if "100" (eqv? 99 (1- 100)))
+ (pass-if "-100" (eqv? -101 (1- -100)))
;; The minimum fixnum on a 32-bit architecture: -2^29.
- (pass-if (eqv? -536870913 (1- -536870912)))
+ (pass-if "1- fixnum = bignum (32-bit)"
+ (eqv? -536870913 (1- -536870912)))
;; The minimum fixnum on a 64-bit architecture: -2^61.
- (pass-if (eqv? -2305843009213693953 (1- -2305843009213693952))))
+ (pass-if "1- fixnum = bignum (64-bit)"
+ (eqv? -2305843009213693953 (1- -2305843009213693952))))
;;;
;;; ash
@@ -2455,16 +2459,27 @@
;;; +
;;;
-(with-test-prefix "+"
+(with-test-prefix/c&e "+"
(pass-if "documented?"
- (documented? +)))
+ (documented? +))
+
+ ;; The maximum fixnum on a 32-bit architecture: 2^29 - 1.
+ (pass-if "fixnum + fixnum = bignum (32-bit)"
+ (eqv? 536870912 (+ 536870910 2)))
+
+ ;; The maximum fixnum on a 64-bit architecture: 2^61 - 1.
+ (pass-if "fixnum + fixnum = bignum (64-bit)"
+ (eqv? 2305843009213693952 (+ 2305843009213693950 2)))
+
+ (pass-if "bignum + fixnum = fixnum"
+ (eqv? 0 (+ (1+ most-positive-fixnum) most-negative-fixnum))))
;;;
;;; -
;;;
-(with-test-prefix "-"
+(with-test-prefix/c&e "-"
(pass-if "-inum - +bignum"
(= #x-100000000000000000000000000000001
@@ -2476,7 +2491,18 @@
(pass-if "big - -inum"
(= #x100000000000000000000000000000001
- (- #x100000000000000000000000000000000 -1))))
+ (- #x100000000000000000000000000000000 -1)))
+
+ ;; The mininum fixnum on a 32-bit architecture: -2^29.
+ (pass-if "fixnum - fixnum = bignum (32-bit)"
+ (eqv? -536870912 (- -536870910 2)))
+
+ ;; The minimum fixnum on a 64-bit architecture: -2^61.
+ (pass-if "fixnum - fixnum = bignum (64-bit)"
+ (eqv? -2305843009213693952 (- -2305843009213693950 2)))
+
+ (pass-if "bignum - fixnum = fixnum"
+ (eqv? most-positive-fixnum (- (1+ most-positive-fixnum) 1))))
;;;
;;; *
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-13-77-g0b54eea,
Ludovic Courtès <=