[Guile-commits] GNU Guile branch, master, updated. release_1-9-12-210-ge78d4bf

[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=e78d4bf9a9501654024a18f8d0baa1597d57fcb8

The branch, master has been updated
       via  e78d4bf9a9501654024a18f8d0baa1597d57fcb8 (commit)
      from  de6b3a5cb919534773e9bde571bdf500dc604eff (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 e78d4bf9a9501654024a18f8d0baa1597d57fcb8
Author: Ludovic Courtès <address@hidden>
Date:   Wed Oct 13 01:31:19 2010 +0200

    Optimize `1+' and `1-' on fixnums.
    
    * libguile/vm-i-scheme.c (INUM_MAX, INUM_MIN): New macros.
      (add1, sub1): Add/subtract without untagging the operand.  This leads
      to a 44% run time improvement compared to the previous
      implementation.
    
    * libguile/vm.c: Include <stdint.h>.
    
    * test-suite/tests/numbers.test ("1+", "1-"): Add tests for
      MOST-POSITIVE-FIXNUM, resp. MOST-NEGATIVE-FIXNUM, for 32-bit and
      34-bit values thereof.
    
    * benchmark-suite/benchmarks/arithmetic.bm: New file.
    
    * benchmark-suite/Makefile.am (SCM_BENCHMARKS): Add it.

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

Summary of changes:
 benchmark-suite/Makefile.am                        |    1 +
 .../benchmarks/{srfi-1.bm => arithmetic.bm}        |   43 ++++++++++----------
 libguile/vm-i-scheme.c                             |   38 ++++++++++++++----
 libguile/vm.c                                      |    1 +
 test-suite/tests/numbers.test                      |   16 ++++++-
 5 files changed, 67 insertions(+), 32 deletions(-)
 copy benchmark-suite/benchmarks/{srfi-1.bm => arithmetic.bm} (58%)

diff --git a/benchmark-suite/Makefile.am b/benchmark-suite/Makefile.am
index e2aad91..63f490c 100644
--- a/benchmark-suite/Makefile.am
+++ b/benchmark-suite/Makefile.am
@@ -1,4 +1,5 @@
 SCM_BENCHMARKS = benchmarks/0-reference.bm             \
+                benchmarks/arithmetic.bm               \
                 benchmarks/bytevectors.bm              \
                 benchmarks/chars.bm                    \
                 benchmarks/continuations.bm            \
diff --git a/benchmark-suite/benchmarks/srfi-1.bm 
b/benchmark-suite/benchmarks/arithmetic.bm
similarity index 58%
copy from benchmark-suite/benchmarks/srfi-1.bm
copy to benchmark-suite/benchmarks/arithmetic.bm
index 835608d..cd8bbbd 100644
--- a/benchmark-suite/benchmarks/srfi-1.bm
+++ b/benchmark-suite/benchmarks/arithmetic.bm
@@ -1,5 +1,5 @@
 ;;; -*- mode: scheme; coding: utf-8; -*-
-;;; SRFI-1.
+;;; Integer arithmetic.
 ;;;
 ;;; Copyright 2010 Free Software Foundation, Inc.
 ;;;
@@ -18,30 +18,29 @@
 ;;; not, write to the Free Software Foundation, Inc., 51 Franklin
 ;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
-(define-module (benchmarks srfi-1)
-  #:use-module (srfi srfi-1)
+(define-module (benchmarks arithmetic)
   #:use-module (benchmark-suite lib))
 
-(define %big-list
-  (iota 1000000))
-
-(define %small-list
-  (iota 10))
-
-
-(with-benchmark-prefix "fold"
-
-  (benchmark "big" 30
-    (fold (lambda (x y) y) #f %big-list))
-
-  (benchmark "small" 2000000
-    (fold (lambda (x y) y) #f %small-list)))
+(define-syntax repeat
+  (lambda (s)
+    ;; Construct an expression of the form `(OP (OP (OP BODY)))', with a
+    ;; depth of COUNT.
+    (syntax-case s ()
+      ((_ op body count)
+       (number? (syntax->datum #'count))
+       (let loop ((count  (syntax->datum #'count))
+                  (result #'body))
+         (if (= 0 count)
+             result
+             (loop (1- count)
+                   (with-syntax ((result result))
+                     #'(op result)))))))))
 
 
-(with-benchmark-prefix "drop-while"
+(with-benchmark-prefix "fixnum"
 
-  (benchmark "big" 30
-    (drop-while (lambda (n) #t) %big-list))
+  (benchmark "1+" 1e7
+    (repeat 1+ 2 100))
 
-  (benchmark "small" 2000000
-    (drop-while (lambda (n) #t) %small-list)))
+  (benchmark "1-" 1e7
+    (repeat 1- 2 100)))
diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c
index 69ea8a5..3e80a0e 100644
--- a/libguile/vm-i-scheme.c
+++ b/libguile/vm-i-scheme.c
@@ -209,6 +209,10 @@ VM_DEFINE_FUNCTION (149, ge, "ge?", 2)
  * Numeric functions
  */
 
+/* The maximum/minimum tagged integers.  */
+#define INUM_MAX (INTPTR_MAX - 1)
+#define INUM_MIN (INTPTR_MIN + scm_tc2_int)
+
 #undef FUNC2
 #define FUNC2(CFUNC,SFUNC)                             \
 {                                                      \
@@ -231,12 +235,21 @@ VM_DEFINE_FUNCTION (150, add, "add", 2)
 VM_DEFINE_FUNCTION (151, add1, "add1", 1)
 {
   ARGS1 (x);
-  if (SCM_I_INUMP (x))
+
+  /* Check for overflow.  */
+  if (SCM_LIKELY ((scm_t_intptr) x < INUM_MAX))
     {
-      scm_t_int64 n = SCM_I_INUM (x) + 1;
-      if (SCM_FIXABLE (n))
-       RETURN (SCM_I_MAKINUM (n));
+      SCM result;
+
+      /* Add the integers without untagging.  */
+      result = SCM_PACK ((scm_t_intptr) x
+                        + (scm_t_intptr) SCM_I_MAKINUM (1)
+                        - scm_tc2_int);
+
+      if (SCM_LIKELY (SCM_I_INUMP (result)))
+       RETURN (result);
     }
+
   SYNC_REGISTER ();
   RETURN (scm_sum (x, SCM_I_MAKINUM (1)));
 }
@@ -249,12 +262,21 @@ VM_DEFINE_FUNCTION (152, sub, "sub", 2)
 VM_DEFINE_FUNCTION (153, sub1, "sub1", 1)
 {
   ARGS1 (x);
-  if (SCM_I_INUMP (x))
+
+  /* Check for underflow.  */
+  if (SCM_LIKELY ((scm_t_intptr) x > INUM_MIN))
     {
-      scm_t_int64 n = SCM_I_INUM (x) - 1;
-      if (SCM_FIXABLE (n))
-       RETURN (SCM_I_MAKINUM (n));
+      SCM result;
+
+      /* Substract the integers without untagging.  */
+      result = SCM_PACK ((scm_t_intptr) x
+                        - (scm_t_intptr) SCM_I_MAKINUM (1)
+                        + scm_tc2_int);
+
+      if (SCM_LIKELY (SCM_I_INUMP (result)))
+       RETURN (result);
     }
+
   SYNC_REGISTER ();
   RETURN (scm_difference (x, SCM_I_MAKINUM (1)));
 }
diff --git a/libguile/vm.c b/libguile/vm.c
index 58d9a9f..e1a90e1 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -24,6 +24,7 @@
 #include <alloca.h>
 #include <alignof.h>
 #include <string.h>
+#include <stdint.h>
 
 #include "libguile/bdw-gc.h"
 #include <gc/gc_mark.h>
diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index 1d7cb7c..3c3e14f 100644
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -109,7 +109,13 @@
   (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 (eqv? -99 (1+ -100)))
+
+  ;; The maximum fixnum on a 32-bit architecture: 2^29 - 1.
+  (pass-if (eqv? 536870912 (1+ 536870911)))
+
+  ;; The maximum fixnum on a 64-bit architecture: 2^61 - 1.
+  (pass-if (eqv? 2305843009213693952 (1+ 2305843009213693951))))
 
 ;;;
 ;;; 1-
@@ -123,7 +129,13 @@
   (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 (eqv? -101 (1- -100)))
+
+  ;; The minimum fixnum on a 32-bit architecture: -2^29.
+  (pass-if (eqv? -536870913 (1- -536870912)))
+
+  ;; The minimum fixnum on a 64-bit architecture: -2^61.
+  (pass-if (eqv? -2305843009213693953 (1- -2305843009213693952))))
 
 ;;;
 ;;; ash


hooks/post-receive
-- 
GNU Guile