summaryrefslogtreecommitdiff
path: root/module/rnrs/arithmetic/fixnums.scm
diff options
context:
space:
mode:
Diffstat (limited to 'module/rnrs/arithmetic/fixnums.scm')
-rw-r--r--module/rnrs/arithmetic/fixnums.scm28
1 files changed, 25 insertions, 3 deletions
diff --git a/module/rnrs/arithmetic/fixnums.scm b/module/rnrs/arithmetic/fixnums.scm
index 7a5a6215e..4ec1cae0c 100644
--- a/module/rnrs/arithmetic/fixnums.scm
+++ b/module/rnrs/arithmetic/fixnums.scm
@@ -242,28 +242,50 @@
(define (fxcopy-bit fx1 fx2 fx3)
(assert-fixnum fx1 fx2 fx3)
+ (unless (and (<= 0 fx2) (< fx2 (fixnum-width)))
+ (raise (make-assertion-violation)))
(bitwise-copy-bit fx1 fx2 fx3))
(define (fxbit-field fx1 fx2 fx3)
(assert-fixnum fx1 fx2 fx3)
+ (unless (and (<= 0 fx2 fx3) (< fx3 (fixnum-width)))
+ (raise (make-assertion-violation)))
(bitwise-bit-field fx1 fx2 fx3))
(define (fxcopy-bit-field fx1 fx2 fx3 fx4)
(assert-fixnum fx1 fx2 fx3 fx4)
+ (unless (and (<= 0 fx2 fx3) (< fx3 (fixnum-width)))
+ (raise (make-assertion-violation)))
(bitwise-copy-bit-field fx1 fx2 fx3 fx4))
- (define (fxarithmetic-shift fx1 fx2) (assert-fixnum fx1 fx2) (ash fx1 fx2))
- (define fxarithmetic-shift-left fxarithmetic-shift)
+ (define (fxarithmetic-shift fx1 fx2)
+ (assert-fixnum fx1 fx2)
+ (unless (< (abs fx2) (fixnum-width))
+ (raise (make-assertion-violation)))
+ (ash fx1 fx2))
+
+ (define (fxarithmetic-shift-left fx1 fx2)
+ (assert-fixnum fx1 fx2)
+ (unless (and (<= 0 fx2) (< fx2 (fixnum-width)))
+ (raise (make-assertion-violation)))
+ (ash fx1 fx2))
(define (fxarithmetic-shift-right fx1 fx2)
- (assert-fixnum fx1 fx2) (ash fx1 (- fx2)))
+ (assert-fixnum fx1 fx2)
+ (unless (and (<= 0 fx2) (< fx2 (fixnum-width)))
+ (raise (make-assertion-violation)))
+ (ash fx1 (- fx2)))
(define (fxrotate-bit-field fx1 fx2 fx3 fx4)
(assert-fixnum fx1 fx2 fx3 fx4)
+ (unless (and (<= 0 fx2 fx3) (< fx3 (fixnum-width)) (< fx4 (- fx3 fx2)))
+ (raise (make-assertion-violation)))
(bitwise-rotate-bit-field fx1 fx2 fx3 fx4))
(define (fxreverse-bit-field fx1 fx2 fx3)
(assert-fixnum fx1 fx2 fx3)
+ (unless (and (<= 0 fx2 fx3) (< fx3 (fixnum-width)))
+ (raise (make-assertion-violation)))
(bitwise-reverse-bit-field fx1 fx2 fx3))
)