summaryrefslogtreecommitdiff
path: root/module/rnrs
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-04-28 15:53:35 +0200
committerAndy Wingo <wingo@pobox.com>2011-04-28 15:53:35 +0200
commit1903eae4c9ab97b575dad4ab1f5cf05436d84ab3 (patch)
treedbb5a83c4dce6f6f10642b3d39ec76ee63dd77a5 /module/rnrs
parent0c81a0c13ad39c381e4ff4d073e3158bcfd51a7a (diff)
parent91956a94fe6363cf69d574b56397962ec6ef4468 (diff)
downloadguile-1903eae4c9ab97b575dad4ab1f5cf05436d84ab3.tar.gz
Merge remote-tracking branch 'origin/stable-2.0'
Conflicts: GUILE-VERSION
Diffstat (limited to 'module/rnrs')
-rw-r--r--module/rnrs/arithmetic/fixnums.scm19
1 files changed, 12 insertions, 7 deletions
diff --git a/module/rnrs/arithmetic/fixnums.scm b/module/rnrs/arithmetic/fixnums.scm
index 0ce245811..e6261999a 100644
--- a/module/rnrs/arithmetic/fixnums.scm
+++ b/module/rnrs/arithmetic/fixnums.scm
@@ -102,17 +102,20 @@
(define (greatest-fixnum) most-positive-fixnum)
(define (least-fixnum) most-negative-fixnum)
- (define-inlinable (fixnum? obj)
+ (define (fixnum? obj)
+ (not (= 0 (logand 2 (object-address obj)))))
+
+ (define-inlinable (inline-fixnum? obj)
(not (= 0 (logand 2 (object-address obj)))))
(define-syntax assert-fixnum
(syntax-rules ()
((_ arg ...)
- (or (and (fixnum? arg) ...)
+ (or (and (inline-fixnum? arg) ...)
(raise (make-assertion-violation))))))
(define (assert-fixnums args)
- (or (for-all fixnum? args) (raise (make-assertion-violation))))
+ (or (for-all inline-fixnum? args) (raise (make-assertion-violation))))
(define-syntax define-fxop*
(syntax-rules ()
@@ -147,13 +150,15 @@
(define (fx+ fx1 fx2)
(assert-fixnum fx1 fx2)
(let ((r (+ fx1 fx2)))
- (or (fixnum? r) (raise (make-implementation-restriction-violation)))
+ (or (inline-fixnum? r)
+ (raise (make-implementation-restriction-violation)))
r))
(define (fx* fx1 fx2)
(assert-fixnum fx1 fx2)
(let ((r (* fx1 fx2)))
- (or (fixnum? r) (raise (make-implementation-restriction-violation)))
+ (or (inline-fixnum? r)
+ (raise (make-implementation-restriction-violation)))
r))
(define* (fx- fx1 #:optional fx2)
@@ -162,10 +167,10 @@
(begin
(assert-fixnum fx2)
(let ((r (- fx1 fx2)))
- (or (fixnum? r) (raise (make-assertion-violation)))
+ (or (inline-fixnum? r) (raise (make-assertion-violation)))
r))
(let ((r (- fx1)))
- (or (fixnum? r) (raise (make-assertion-violation)))
+ (or (inline-fixnum? r) (raise (make-assertion-violation)))
r)))
(define (fxdiv fx1 fx2)