fix JIT abs (on least fixnum), fix some R6RS bugs and pull in some R6RS test cases from Ikarus

svn: r9477
2008-04-25 17:18:44 +00:00 · 2008-04-25 17:18:44 +00:00 · 0483294762
commit 0483294762
parent 758a191ffe
14 changed files with 859 additions and 41 deletions
--- a/collects/drscheme/syncheck.ss
+++ b/collects/drscheme/syncheck.ss
@ -1440,7 +1440,7 @@ If the namespace does not, they are colored the unbound color.
                                   (when (eq? nominal-source-id jump-to-id)
                                     (jump-to id))))))
                           (syntax->list vars))))])
-        
+
        (let level-loop ([sexp sexp]
                         [high-level? #f])
          
--- a/collects/rnrs/arithmetic/fixnums-6.ss
+++ b/collects/rnrs/arithmetic/fixnums-6.ss
@ -55,10 +55,22 @@
 (define-fx * fx* (a b) check)
 (define-fx - fx- [(a) (a b)] check)

-(define-fx div-and-mod fxdiv-and-mod (a b) nocheck)
+(provide fxdiv-and-mod
+         fxdiv0-and-mod0)
+(define (fxdiv-and-mod a b)
+  (unless (fixnum? a)
+    (raise-type-error 'fxdiv-and-mod "fixnum" a))
+  (unless (fixnum? b)
+    (raise-type-error 'fxdiv-and-mod "fixnum" b))
+  (div-and-mod a b))
 (define-fx div fxdiv (a b) nocheck)
 (define-fx mod fxmod (a b) nocheck)
-(define-fx div0-and-mod0 fxdiv0-and-mod0 (a b) nocheck)
+(define (fxdiv0-and-mod0 a b)
+  (unless (fixnum? a)
+    (raise-type-error 'fxdiv0-and-mod0 "fixnum" a))
+  (unless (fixnum? b)
+    (raise-type-error 'fxdiv0-and-mod0 "fixnum" b))
+  (div0-and-mod0 a b))
 (define-fx div0 fxdiv0 (a b) nocheck)
 (define-fx mod0 fxmod0 (a b) nocheck)

@ -72,13 +84,13 @@
        (raise-type-error 'fx/carry "fixnum" b))
      (unless (fixnum? a)
        (raise-type-error 'fx/carry "fixnum" b))
-      (let-values ([(d m) (div0-and-mod0 (+ a b c) 
+      (let-values ([(d m) (div0-and-mod0 expr
                                         (arithmetic-shift 1 (fixnum-width)))])
        (values m d)))))

 (define-carry fx+/carry (a b c) (+ a b c))
 (define-carry fx-/carry (a b c) (- a b c))
-(define-carry fx*/carry (a b c) (* (+ a b) c))
+(define-carry fx*/carry (a b c) (+ (* a b) c))

 (define-fx bitwise-not fxnot (a) nocheck)
 (define-fx bitwise-and fxand (a b ...) nocheck)
--- a/collects/rnrs/arithmetic/flonums-6.ss
+++ b/collects/rnrs/arithmetic/flonums-6.ss
@ -49,10 +49,22 @@

 (define-fl abs flabs (a) nocheck)

-(define-fl div-and-mod fldiv-and-mod (a b) nocheck)
+(provide fldiv-and-mod
+         fldiv0-and-mod0)
+(define (fldiv-and-mod a b)
+  (unless (inexact-real? a)
+    (raise-type-error 'fldiv-and-mod "flonum" a))
+  (unless (inexact-real? b)
+    (raise-type-error 'fldiv-and-mod "flonum" b))
+  (div-and-mod a b))
 (define-fl div fldiv (a b) nocheck)
 (define-fl mod flmod (a b) nocheck)
-(define-fl div0-and-mod0 fldiv0-and-mod0 (a b) nocheck)
+(define (fldiv0-and-mod0 a b)
+  (unless (inexact-real? a)
+    (raise-type-error 'fldiv0-and-mod0 "flonum" a))
+  (unless (inexact-real? b)
+    (raise-type-error 'fldiv0-and-mod0 "flonum" b))
+  (div0-and-mod0 a b))
 (define-fl div0 fldiv0 (a b) nocheck)
 (define-fl mod0 flmod0 (a b) nocheck)

--- a/collects/rnrs/base-6.ss
+++ b/collects/rnrs/base-6.ss
@ -210,30 +210,22 @@
 ;; until the results matched the examples in R6RS.

 (define (div x y)
-  (let ([n (* (numerator x)
-              (denominator y))]
-        [d (* (denominator x)
-              (numerator y))])
-    (if (negative? n)
-        (- (quotient (- (abs d) n 1) d))
-        (quotient n d))))
-
-(define (div0 x y)
  (cond
-   [(zero? y) 0]
-   [(positive? y)
-    (if (negative? x)
-        (- (div (- x) y))
-        (div x y))]
-   [(negative? y)
-    (let ([n (* -2
-                (numerator x)
+   [(rational? y)
+    (let ([n (* (numerator x)
                (denominator y))]
          [d (* (denominator x)
-                (- (numerator y)))])
-      (if (< n d)
-          (- (quotient (- d n) (* 2 d)))
-          (quotient (+ n d -1) (* 2 d))))]))
+                (numerator y))])
+      (if (negative? n)
+          (- (quotient (- (abs d) n 1) d))
+          (quotient n d)))]
+   [(real? y)
+    ;; infinity or nan
+    (if (equal? y +nan.0)
+        +nan.0
+        1.0)]
+   [else
+    (raise-type-error "real number" y)]))

 (define (mod x y)
  (- x (* (div x y) y)))
@ -242,12 +234,21 @@
  (let ([d (div x y)])
    (values d (- x (* d y)))))

-(define (mod0 x y)
-  (- x (* (div0 x y) y)))
-
 (define (div0-and-mod0 x y)
-  (let ([d (div0 x y)])
-    (values d (- x (* d y)))))
+  (let-values ([(d m) (div-and-mod x y)])
+    (if (>= m (/ (abs y) 2))
+        (if (negative? y)
+            (values (sub1 d) (+ m y))
+            (values (add1 d) (- m y)))
+        (values d m))))
+
+(define (div0 x y)
+  (let-values ([(d m) (div0-and-mod0 x y)])
+    d))
+
+(define (mod0 x y)
+  (let-values ([(d m) (div0-and-mod0 x y)])
+    m))

 (define-syntax r6rs:/
  ;; R6RS says that division with exact zero is treated like 
--- a/collects/rnrs/bytevectors-6.ss
+++ b/collects/rnrs/bytevectors-6.ss
@ -281,7 +281,7 @@
  (let ([pos-n (if (negative? n)
                   (+ n (arithmetic-shift 1 (* 8 size)))
                   n)])
-    (bytevector-int-set! 'bytevector-uint-set! bstr k pos-n n endianness size (* size (sub1 8)))))
+    (bytevector-int-set! 'bytevector-sint-set! bstr k pos-n n endianness size (sub1 (* size 8)))))

 (define (bytevector->int-list who ref bv endianness size)
  (unless (bytes? bv)
--- a/collects/tests/mzscheme/optimize.ss
+++ b/collects/tests/mzscheme/optimize.ss
@ -230,8 +230,10 @@
    (un 0 'abs 0)
    (un 1 'abs 1)
    (un 1 'abs -1)
-    (un (sub1 (expt 2 31)) 'abs (sub1 (expt 2 31)))
-    (un (sub1 (expt 2 31)) 'abs (add1 (expt -2 31)))
+    (un (sub1 (expt 2 30)) 'abs (sub1 (expt 2 30)))
+    (un (expt 2 30) 'abs (- (expt 2 30)))
+    (un (sub1 (expt 2 62)) 'abs (sub1 (expt 2 62)))
+    (un (expt 2 62) 'abs (- (expt 2 62)))

    (bin 11 '+ 4 7)
    (bin -3 '+ 4 -7)
--- a/collects/tests/r6rs/arithmetic/bitwise.ss
+++ b/collects/tests/r6rs/arithmetic/bitwise.ss
@ -5,6 +5,33 @@
  (import (rnrs)
          (tests r6rs test))

+  ;; Helpers originally from Ikarus test suite:
+  (define (ref ei)
+    (do ((result 0 (+ result 1)) 
+         (bits (if (negative? ei) 
+                   (bitwise-not ei) 
+                   ei) 
+               (bitwise-arithmetic-shift bits -1))) 
+        ((zero? bits)
+         result)))
+  (define-syntax len-test
+    (syntax-rules ()
+      [(_ n) (test (bitwise-length n)
+                   (ref n))]))
+  (define (pos-count-bits n)
+    (if (zero? n) 
+        0
+        (let ([c (count-bits (bitwise-arithmetic-shift-right n 1))])
+          (if (even? n) c (+ c 1)))))
+  (define (count-bits n)
+    (if (>= n 0)
+        (pos-count-bits n)
+        (bitwise-not (pos-count-bits (bitwise-not n)))))
+  (define-syntax count-test
+    (syntax-rules ()
+      [(_ n)
+       (test (bitwise-bit-count n) (count-bits n))]))
+      
  (define (run-arithmetic-bitwise-tests)

    (test (bitwise-first-bit-set 0)         -1)
@ -19,7 +46,206 @@
    (test (bitwise-arithmetic-shift -1 -1) -1)
    
    (test (bitwise-reverse-bit-field #b1010010 1 4)    88) ; #b1011000
-          
+
+    ;; Originally from Ikarus test suite:
+    (len-test #xF)
+    (len-test #xFF)
+    (len-test #xFFF)
+    (len-test #xFFFF)
+    (len-test #xFFFFF)
+    (len-test #xFFFFFF)
+    (len-test #xFFFFFFF)
+    (len-test #xFFFFFFFF)
+    (len-test #xFFFFFFFFF)
+    (len-test #xFFFFFFFFFF)
+    (len-test #xFFFFFFFFFFF)
+    (len-test #xFFFFFFFFFFFF)
+    (len-test #xFFFFFFFFFFFFF)
+    (len-test #xFFFFFFFFFFFFFF)
+    (len-test #xFFFFFFFFFFFFFFF)
+    (len-test #xFFFFFFFFFFFFFFFF)
+    (len-test #x-F)
+    (len-test #x-FF)
+    (len-test #x-FFF)
+    (len-test #x-FFFF)
+    (len-test #x-FFFFF)
+    (len-test #x-FFFFFF)
+    (len-test #x-FFFFFFF)
+    (len-test #x-FFFFFFFF)
+    (len-test #x-FFFFFFFFF)
+    (len-test #x-FFFFFFFFFF)
+    (len-test #x-FFFFFFFFFFF)
+    (len-test #x-FFFFFFFFFFFF)
+    (len-test #x-FFFFFFFFFFFFF)
+    (len-test #x-FFFFFFFFFFFFFF)
+    (len-test #x-FFFFFFFFFFFFFFF)
+    (len-test #x-FFFFFFFFFFFFFFFF)
+
+    (len-test #xE)
+    (len-test #xFE)
+    (len-test #xFFE)
+    (len-test #xFFFE)
+    (len-test #xFFFFE)
+    (len-test #xFFFFFE)
+    (len-test #xFFFFFFE)
+    (len-test #xFFFFFFFE)
+    (len-test #xFFFFFFFFE)
+    (len-test #xFFFFFFFFFE)
+    (len-test #xFFFFFFFFFFE)
+    (len-test #xFFFFFFFFFFFE)
+    (len-test #xFFFFFFFFFFFFE)
+    (len-test #xFFFFFFFFFFFFFE)
+    (len-test #xFFFFFFFFFFFFFFE)
+    (len-test #xFFFFFFFFFFFFFFFE)
+    (len-test #x-E)
+    (len-test #x-FE)
+    (len-test #x-FFE)
+    (len-test #x-FFFE)
+    (len-test #x-FFFFE)
+    (len-test #x-FFFFFE)
+    (len-test #x-FFFFFFE)
+    (len-test #x-FFFFFFFE)
+    (len-test #x-FFFFFFFFE)
+    (len-test #x-FFFFFFFFFE)
+    (len-test #x-FFFFFFFFFFE)
+    (len-test #x-FFFFFFFFFFFE)
+    (len-test #x-FFFFFFFFFFFFE)
+    (len-test #x-FFFFFFFFFFFFFE)
+    (len-test #x-FFFFFFFFFFFFFFE)
+    (len-test #x-FFFFFFFFFFFFFFFE)
+
+    (len-test #x1)
+    (len-test #x1F)
+    (len-test #x1FF)
+    (len-test #x1FFF)
+    (len-test #x1FFFF)
+    (len-test #x1FFFFF)
+    (len-test #x1FFFFFF)
+    (len-test #x1FFFFFFF)
+    (len-test #x1FFFFFFFF)
+    (len-test #x1FFFFFFFFF)
+    (len-test #x1FFFFFFFFFF)
+    (len-test #x1FFFFFFFFFFF)
+    (len-test #x1FFFFFFFFFFFF)
+    (len-test #x1FFFFFFFFFFFFF)
+    (len-test #x1FFFFFFFFFFFFFF)
+    (len-test #x1FFFFFFFFFFFFFFF)
+    (len-test #x-1)
+    (len-test #x-1F)
+    (len-test #x-1FF)
+    (len-test #x-1FFF)
+    (len-test #x-1FFFF)
+    (len-test #x-1FFFFF)
+    (len-test #x-1FFFFFF)
+    (len-test #x-1FFFFFFF)
+    (len-test #x-1FFFFFFFF)
+    (len-test #x-1FFFFFFFFF)
+    (len-test #x-1FFFFFFFFFF)
+    (len-test #x-1FFFFFFFFFFF)
+    (len-test #x-1FFFFFFFFFFFF)
+    (len-test #x-1FFFFFFFFFFFFF)
+    (len-test #x-1FFFFFFFFFFFFFF)
+    (len-test #x-1FFFFFFFFFFFFFFF)
+
+    (len-test #x1)
+    (len-test #x10)
+    (len-test #x100)
+    (len-test #x1000)
+    (len-test #x10000)
+    (len-test #x100000)
+    (len-test #x1000000)
+    (len-test #x10000000)
+    (len-test #x100000000)
+    (len-test #x1000000000)
+    (len-test #x10000000000)
+    (len-test #x100000000000)
+    (len-test #x1000000000000)
+    (len-test #x10000000000000)
+    (len-test #x100000000000000)
+    (len-test #x1000000000000000)
+    (len-test #x-1)
+    (len-test #x-10)
+    (len-test #x-100)
+    (len-test #x-1000)
+    (len-test #x-10000)
+    (len-test #x-100000)
+    (len-test #x-1000000)
+    (len-test #x-10000000)
+    (len-test #x-100000000)
+    (len-test #x-1000000000)
+    (len-test #x-10000000000)
+    (len-test #x-100000000000)
+    (len-test #x-1000000000000)
+    (len-test #x-10000000000000)
+    (len-test #x-100000000000000)
+    (len-test #x-1000000000000000)
+
+    (len-test #x1)
+    (len-test #x11)
+    (len-test #x101)
+    (len-test #x1001)
+    (len-test #x10001)
+    (len-test #x100001)
+    (len-test #x1000001)
+    (len-test #x10000001)
+    (len-test #x100000001)
+    (len-test #x1000000001)
+    (len-test #x10000000001)
+    (len-test #x100000000001)
+    (len-test #x1000000000001)
+    (len-test #x10000000000001)
+    (len-test #x100000000000001)
+    (len-test #x1000000000000001)
+    (len-test #x-1)
+    (len-test #x-11)
+    (len-test #x-101)
+    (len-test #x-1001)
+    (len-test #x-10001)
+    (len-test #x-100001)
+    (len-test #x-1000001)
+    (len-test #x-10000001)
+    (len-test #x-100000001)
+    (len-test #x-1000000001)
+    (len-test #x-10000000001)
+    (len-test #x-100000000001)
+    (len-test #x-1000000000001)
+    (len-test #x-10000000000001)
+    (len-test #x-100000000000001)
+    (len-test #x-1000000000000001)
+
+    (len-test (greatest-fixnum))
+    (len-test (least-fixnum))
+
+    (count-test 1)
+    (count-test 28472347823493290482390849023840928390482309480923840923840983)
+    (count-test -847234234903290482390849023840928390482309480923840923840983)
+    (count-test (greatest-fixnum))
+    (count-test (least-fixnum))
+    
+    (test (bitwise-not 12) -13)
+    (test (bitwise-not -12) 11)
+    (test (bitwise-not -1) 0)
+    (test (bitwise-not 0) -1)
+    (test (least-fixnum) (bitwise-not (greatest-fixnum)))
+    (test (greatest-fixnum) (bitwise-not (least-fixnum)))
+
+    (test (bitwise-not 38947389478348937489374)
+          -38947389478348937489375)
+    (test (bitwise-not #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)
+          -22300745198530623141535718272648361505980416)
+    (test (bitwise-not -38947389478348937489375)
+          38947389478348937489374)
+    (test (bitwise-not #x-FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)
+          22300745198530623141535718272648361505980414)
+    (test (bitwise-not #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)
+          -340282366920938463463374607431768211456)
+    (test (bitwise-not #x-FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)
+          340282366920938463463374607431768211454)
+    (test (bitwise-not #x1000000000000000000000000)
+          -79228162514264337593543950337)
+    (test (bitwise-not #x-1000000000000000000000000)
+          79228162514264337593543950335)
+
    ;;
    ))

--- a/collects/tests/r6rs/arithmetic/fixnums.ss
+++ b/collects/tests/r6rs/arithmetic/fixnums.ss
@ -5,6 +5,40 @@
  (import (rnrs)
          (tests r6rs test))

+  ;; Originally from Ikarus test suite:
+  (define (fx*/carry-reference fx1 fx2 fx3)
+    (let* ([s (+ (* fx1 fx2) fx3)]
+           [s0 (mod0 s (expt 2 (fixnum-width)))]
+           [s1 (div0 s (expt 2 (fixnum-width)))])
+      (values s0 s1)))
+  (define (fx+/carry-reference fx1 fx2 fx3)
+    (let* ([s (+ (+ fx1 fx2) fx3)]
+           [s0 (mod0 s (expt 2 (fixnum-width)))]
+           [s1 (div0 s (expt 2 (fixnum-width)))])
+      (values s0 s1)))
+  (define (fx-/carry-reference fx1 fx2 fx3)
+    (let* ([s (- (- fx1 fx2) fx3)]
+           [s0 (mod0 s (expt 2 (fixnum-width)))]
+           [s1 (div0 s (expt 2 (fixnum-width)))])
+      (values s0 s1)))
+
+  (define-syntax carry-test
+    (syntax-rules ()
+      [(_ fxop/carry fxop/carry-reference fx1 fx2 fx3)
+       (test (call-with-values (lambda () (fxop/carry fx1 fx2 fx3)) list)
+             (call-with-values (lambda () (fxop/carry-reference fx1 fx2 fx3)) list))]))
+
+  (define-syntax carry-tests
+    (syntax-rules ()
+      [(_ 0 nums)
+       (carry-tests 0 nums nums nums)]
+      [(_ 0 (n ...) ms ps)
+       (begin (carry-tests 1 n ms ps) ...)]
+      [(_ 1 n (m ...) ps)
+       (begin (carry-tests 2 n m ps) ...)]
+      [(_ 2 n m (p ...))
+       (begin (carry-test fx*/carry fx*/carry-reference n m p) ...)]))
+
  (define (run-arithmetic-fixnums-tests)

    (test/exn (fx- (least-fixnum)) &implementation-restriction)
@ -144,6 +178,9 @@
    (test (fx- (greatest-fixnum) (greatest-fixnum)) 0)
    (test (fx- (least-fixnum) (least-fixnum)) 0)

+    ;; If you put N numbers here, it expads to N^3 tests!
+    (carry-tests 0 [0 1 2 -1 -2 38734 -3843 2484598 -348732487 (greatest-fixnum) (least-fixnum)])
+
    ;;
    ))

--- a/collects/tests/r6rs/base.ss
+++ b/collects/tests/r6rs/base.ss
@ -35,6 +35,33 @@
    (or (equal? v '(1 2))
        (equal? v '(2 1))))

+  ;; Based on tests from Ikarus:
+  (define-syntax divmod-test/?
+    (syntax-rules ()
+      [(_ x1 x2)
+       (begin
+         (test/values (div-and-mod x1 x2)
+                      (div x1 x2)
+                      (mod x1 x2))
+         (test/values (div0-and-mod0 x1 x2)
+                      (div0 x1 x2)
+                      (mod0 x1 x2)))]))
+  (define-syntax divmod-test
+    (syntax-rules ()
+      [(_ x1 x2)
+       (begin
+         (divmod-test/? x1 x2)
+         (test (<= 0 (mod x1 x2)) #t)
+         (test (< (mod x1 x2) (abs x2)) #t)
+         (test (+ (* (div x1 x2) x2) (mod x1 x2)) x1)
+         (test (<= (- (abs (/ x2 2))) (mod0 x1 x2)) #t)
+         (test (< (mod0 x1 x2) (abs (/ x2 2))) #t)
+         (test (+ (* (div0 x1 x2) x2) (mod0 x1 x2)) x1))]))
+
+  (define-syntax test-string-to-number
+    (syntax-rules ()
+      [(_ [str num] ...) (begin (test (string->number str) num) ...)]))
+
  ;; Definitions ----------------------------------------

  (define add3
@ -560,6 +587,126 @@
    (test (div0 -123 -10) 12)
    (test (mod0 -123 -10) -3)

+    ;; `divmod-test' cases originally from Ikarus:
+
+    (divmod-test +17 +3)
+    (divmod-test +17 -3)
+    (divmod-test -17 +3)
+    (divmod-test -17 -3)
+    (divmod-test +16 +3)
+    (divmod-test +16 -3)
+    (divmod-test -16 +3)
+    (divmod-test -16 -3)
+    (divmod-test +15 +3)
+    (divmod-test +15 -3)
+    (divmod-test -15 +3)
+    (divmod-test -15 -3)
+    (divmod-test +10 +4)
+    (divmod-test +10 -4)
+    (divmod-test -10 +4)
+    (divmod-test -10 -4)
+
+    (divmod-test +3 +5/6)
+    (divmod-test -3 +5/6)
+    (divmod-test +3 -5/6)
+    (divmod-test -3 -5/6)
+
+    (divmod-test +3 +7/11)
+    (divmod-test -3 +7/11)
+    (divmod-test +3 -7/11)
+    (divmod-test -3 -7/11)
+
+    (divmod-test (least-fixnum)    +1)
+    (divmod-test (least-fixnum)    -1)
+    (divmod-test (greatest-fixnum) +1)
+    (divmod-test (greatest-fixnum) -1)
+    (divmod-test (least-fixnum)    +2)
+    (divmod-test (least-fixnum)    -2)
+    (divmod-test (greatest-fixnum) +2)
+    (divmod-test (greatest-fixnum) -2)
+
+    (divmod-test 0 (least-fixnum))
+    (divmod-test 0 (greatest-fixnum))
+    (divmod-test +1 (least-fixnum))
+    (divmod-test +1 (greatest-fixnum))
+    (divmod-test -1 (least-fixnum))
+    (divmod-test -1 (greatest-fixnum))
+    (divmod-test +2 (least-fixnum))
+    (divmod-test +2 (greatest-fixnum))
+    (divmod-test -2 (least-fixnum))
+    (divmod-test -2 (greatest-fixnum))
+
+    (divmod-test (least-fixnum) (least-fixnum))
+    (divmod-test (greatest-fixnum) (least-fixnum))
+    (divmod-test (least-fixnum) (greatest-fixnum))
+    (divmod-test (greatest-fixnum) (greatest-fixnum))    
+
+    (divmod-test +17.0 +3.0)
+    (divmod-test +17.0 -3.0)
+    (divmod-test -17.0 +3.0)
+    (divmod-test -17.0 -3.0)
+    (divmod-test +16.0 +3.0)
+    (divmod-test +16.0 -3.0)
+    (divmod-test -16.0 +3.0)
+    (divmod-test -16.0 -3.0)
+    (divmod-test +15.0 +3.0)
+    (divmod-test +15.0 -3.0)
+    (divmod-test -15.0 +3.0)
+    (divmod-test -15.0 -3.0)
+    (divmod-test +17.0 +3.5)
+    (divmod-test +17.0 -3.5)
+    (divmod-test -17.0 +3.5)
+    (divmod-test -17.0 -3.5)
+    (divmod-test +16.0 +3.5)
+    (divmod-test +16.0 -3.5)
+    (divmod-test -16.0 +3.5)
+    (divmod-test -16.0 -3.5)
+    (divmod-test +15.0 +3.5)
+    (divmod-test +15.0 -3.5)
+    (divmod-test -15.0 +3.5)
+    (divmod-test -15.0 -3.5)
+    (divmod-test/? +17.0 +nan.0)
+    (divmod-test/? -17.0 +nan.0)
+    (divmod-test/? +17.0 +inf.0)
+    (divmod-test/? +17.0 -inf.0)
+    (divmod-test/? -17.0 +inf.0)
+    (divmod-test/? -17.0 -inf.0)
+
+    (divmod-test +17.0 +3.0)
+    (divmod-test +17.0 -3.0)
+    (divmod-test -17.0 +3.0)
+    (divmod-test -17.0 -3.0)
+    (divmod-test +16.0 +3.0)
+    (divmod-test +16.0 -3.0)
+    (divmod-test -16.0 +3.0)
+    (divmod-test -16.0 -3.0)
+    (divmod-test +15.0 +3.0)
+    (divmod-test +15.0 -3.0)
+    (divmod-test -15.0 +3.0)
+    (divmod-test -15.0 -3.0)
+    (divmod-test +17.0 +3.5)
+    (divmod-test +17.0 -3.5)
+    (divmod-test -17.0 +3.5)
+    (divmod-test -17.0 -3.5)
+    (divmod-test +16.0 +3.5)
+    (divmod-test +16.0 -3.5)
+    (divmod-test -16.0 +3.5)
+    (divmod-test -16.0 -3.5)
+    (divmod-test +15.0 +3.5)
+    (divmod-test +15.0 -3.5)
+    (divmod-test -15.0 +3.5)
+    (divmod-test -15.0 -3.5)
+    (divmod-test +10.0 +4.0)
+    (divmod-test +10.0 -4.0)
+    (divmod-test -10.0 +4.0)
+    (divmod-test -10.0 -4.0)
+    (divmod-test/? +17.0 +nan.0)
+    (divmod-test/? -17.0 +nan.0)
+    (divmod-test/? +17.0 +inf.0)
+    (divmod-test/? +17.0 -inf.0)
+    (divmod-test/? -17.0 +inf.0)
+    (divmod-test/? -17.0 -inf.0)
+
    (test (gcd 32 -36)                            4)
    (test (gcd)                                   0)
    (test (lcm 32 -36)                            288)
@ -656,6 +803,53 @@
    (test (string->number "-inf.0")               -inf.0)
    (test (string->number "+nan.0")               +nan.0)

+    ;; Originally from Ikarus:
+    (test-string-to-number
+     ("10" 10)
+     ("1" 1)
+     ("-17" -17)
+     ("+13476238746782364786237846872346782364876238477" 
+      13476238746782364786237846872346782364876238477)
+     ("1/2" (/ 1 2))
+     ("-1/2" (/ 1 -2))
+     ("#x24" 36)
+     ("#x-24" -36)
+     ("#b+00000110110" 54)
+     ("#b-00000110110/10" -27)
+     ("#e10" 10)
+     ("#e1" 1)
+     ("#e-17" -17)
+     ("#e#x24" 36)
+     ("#e#x-24" -36)
+     ("#e#b+00000110110" 54)
+     ("#e#b-00000110110/10" -27)
+     ("#x#e24" 36)
+     ("#x#e-24" -36)
+     ("#b#e+00000110110" 54)
+     ("#b#e-00000110110/10" -27)
+     ("#e1e1000" (expt 10 1000))
+     ("#e-1e1000" (- (expt 10 1000)))
+     ("#e1e-1000" (expt 10 -1000))
+     ("#e-1e-1000" (- (expt 10 -1000)))
+     ("#i1e100" (inexact (expt 10 100)))
+     ("#i1e1000" (inexact (expt 10 1000)))
+     ("#i-1e1000" (inexact (- (expt 10 1000))))
+     ("1e100" (inexact (expt 10 100)))
+     ("1.0e100" (inexact (expt 10 100)))
+     ("1.e100" (inexact (expt 10 100)))
+     ("0.1e100" (inexact (expt 10 99)))
+     (".1e100" (inexact (expt 10 99)))
+     ("+1e100" (inexact (expt 10 100)))
+     ("+1.0e100" (inexact (expt 10 100)))
+     ("+1.e100" (inexact (expt 10 100)))
+     ("+0.1e100" (inexact (expt 10 99)))
+     ("+.1e100" (inexact (expt 10 99)))
+     ("-1e100" (inexact (- (expt 10 100))))
+     ("-1.0e100" (inexact (- (expt 10 100))))
+     ("-1.e100" (inexact (- (expt 10 100))))
+     ("-0.1e100" (inexact (- (expt 10 99))))
+     ("-.1e100" (inexact (- (expt 10 99)))))
+
    ;; 11.8
    (test (not #t)    #f)
    (test (not 3)           #f)
--- a/collects/tests/r6rs/bytevectors.ss
+++ b/collects/tests/r6rs/bytevectors.ss
@ -7,6 +7,9 @@

  (define (run-bytevectors-tests)
    
+    ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Tests originally from R6RS
+    
    (test (let ((b (u8-list->bytevector '(1 2 3 4 5 6 7 8))))
            (bytevector-copy! b 0 b 3 4)
            (bytevector->u8-list b)) 
@ -101,9 +104,192 @@
      (test (bytevector-s64-ref b 8 (endianness little)) -144115188075855873)
      (test (bytevector-u64-ref b 8 (endianness big)) 18446744073709551613)
      (test (bytevector-s64-ref b 8 (endianness big)) -3))
+    
+    ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Tests originally from Ikarus
+
+    (test (bytevector? (make-bytevector 1)) #t)
+    (test (bytevector? (make-bytevector 1 17)) #t)
+    (test (bytevector? (make-bytevector 10 -17)) #t)
+    (test (bytevector? 'foo) #f)
+    (test (bytevector? "hey") #f)
+    (test (bytevector? '#(2837 2398 239)) #f)
+    (test (bytevector-length (make-bytevector 0)) 0)
+    (test (bytevector-length (make-bytevector 100 -30)) 100)
+    (test (let ((b (u8-list->bytevector '(1 2 3 4 5 6 7 8))))
+            (bytevector-copy! b 0 b 3 4)
+            (bytevector->u8-list b))
+          '(1 2 3 1 2 3 4 8))
+    (test (bytevector-uint-ref 
+           (u8-list->bytevector '(17))
+           0 'little 1)
+          17)
+    (test (bytevector-uint-ref 
+           (u8-list->bytevector '(17))
+           0 'big 1)
+          17)
+    (test (bytevector-uint-ref 
+           (u8-list->bytevector '(17 54))
+           0 'little 2)
+          (+ 17 (* 54 256)))
+    (test (bytevector-uint-ref 
+           (u8-list->bytevector (reverse '(17 54)))
+           0 'big 2)
+          (+ 17 (* 54 256)))
+    (test (bytevector-uint-ref 
+           (u8-list->bytevector '(17 54 98))
+           0 'little 3)
+          (+ 17 (* 54 256) (* 98 256 256)))
+    (test (bytevector-uint-ref 
+           (u8-list->bytevector (reverse '(17 54 98)))
+           0 'big 3)
+          (+ 17 (* 54 256) (* 98 256 256)))
+    (test (bytevector-uint-ref 
+           (u8-list->bytevector '(17 54 98 120))
+           0 'little 4)
+          (+ 17 (* 54 256) (* 98 256 256) (* 120 256 256 256)))
+
+    (test (bytevector-uint-ref 
+           (u8-list->bytevector
+            '(#x89 #x04 #x39 #x82 #x49 #x20 #x93 #x48 #x17
+                   #x83 #x79 #x94 #x38 #x87 #x34 #x97 #x38 #x12))
+           0 'little 18)
+          #x123897348738947983174893204982390489)
+    (test (bytevector-uint-ref 
+           (u8-list->bytevector
+            (reverse
+             '(#x89 #x04 #x39 #x82 #x49 #x20 #x93 #x48 #x17
+                    #x83 #x79 #x94 #x38 #x87 #x34 #x97 #x38 #x12)))
+           0 'big 18)
+          #x123897348738947983174893204982390489)
+    (test (let ((b (u8-list->bytevector '(1 2 3 255 1 2 1 2))))
+            (bytevector->uint-list b 'little 2))
+          '(513 65283 513 513))
+    (test (let ((b (u8-list->bytevector '(1 2 3 255 1 2 1 2))))
+            (bytevector->sint-list b 'little 2))
+          '(513 -253 513 513))
+    (test (let ((b (make-bytevector 16 -127)))
+            (bytevector-uint-set! b 0 (- (expt 2 128) 3) 'little 16)
+            (list 
+             (bytevector-uint-ref b 0 'little 16)
+             (bytevector-sint-ref b 0 'little 16)
+             (bytevector->u8-list b)))
+          '(#xfffffffffffffffffffffffffffffffd
+            -3
+            (253 255 255 255 255 255 255 255
+                 255 255 255 255 255 255 255 255)))
+    (test (let ((b (make-bytevector 16 -127)))
+            (bytevector-uint-set! b 0 (- (expt 2 128) 3) 'big 16)
+            (list 
+             (bytevector-uint-ref b 0 'big 16)
+             (bytevector-sint-ref b 0 'big 16)
+             (bytevector->u8-list b)))
+          '(#xfffffffffffffffffffffffffffffffd
+            -3
+            (255 255 255 255 255 255 255 255
+                 255 255 255 255 255 255 255 253)))
+    (test (bytevector->u8-list '#vu8(1 2 3 4))
+          '(1 2 3 4))
+    (test (let ((b (make-bytevector 4 0)))
+            (bytevector-sint-set! b 0 -1 'little 4)
+            (bytevector-uint-ref b 0 'little 4))
+          #xFFFFFFFF)
+    (test (let ((b (make-bytevector 4 0)))
+            (bytevector-sint-set! b 0 -256 'little 4)
+            (bytevector-uint-ref b 0 'little 4))
+          #xFFFFFF00)
+    (test (let ((b (make-bytevector 4 0)))
+            (bytevector-sint-set! b 0 (- (expt 256 2)) 'little 4)
+            (bytevector-uint-ref b 0 'little 4))
+          #xFFFF0000)
+    (test (let ((b (make-bytevector 8 0)))
+            (bytevector-sint-set! b 0 (- (expt 256 2)) 'little 8)
+            (bytevector-uint-ref b 0 'little 8))
+          #xFFFFFFFFFFFF0000)
+    (test (let ((b (make-bytevector 8 0)))
+            (bytevector-sint-set! b 0 (- (expt 256 4)) 'little 8)
+            (bytevector-uint-ref b 0 'little 8))
+          #xFFFFFFFF00000000)
+    (test (let ((b (make-bytevector 8 0)))
+            (bytevector-sint-set! b 0 (- (expt 256 7)) 'little 8)
+            (bytevector-uint-ref b 0 'little 8))
+          #xFF00000000000000)
+    (test (let ((b (make-bytevector 8 0)))
+            (bytevector-sint-set! b 0 (- 1 (expt 2 63)) 'little 8)
+            (bytevector-sint-ref b 0 'little 8))
+          (- 1 (expt 2 63)))
+    (test (let ((b (make-bytevector 4 38)))
+            (bytevector-sint-set! b 0 (- (expt 2 31) 1) 'little 4)
+            (bytevector-sint-ref b 0 'little 4))
+          #x7FFFFFFF)
+    (test (let ((b (make-bytevector 4 38)))
+            (bytevector-sint-set! b 0 (- (expt 2 31)) 'little 4)
+            (bytevector-sint-ref b 0 'little 4))
+          #x-80000000)
+    (test (let ((b (make-bytevector 5 38)))
+            (bytevector-sint-set! b 0 (- (expt 2 32)) 'little 5)
+            (bytevector-sint-ref b 0 'little 5))
+          #x-100000000)
+    (test (let ((b (make-bytevector 4 0)))
+            (bytevector-sint-set! b 0 -1 'big 4)
+            (bytevector-uint-ref b 0 'big 4))
+          #xFFFFFFFF)
+    (test (let ((b (make-bytevector 4 0)))
+            (bytevector-sint-set! b 0 -256 'big 4)
+            (bytevector-uint-ref b 0 'big 4))
+          #xFFFFFF00)
+    (test (let ((b (make-bytevector 4 0)))
+            (bytevector-sint-set! b 0 (- (expt 256 2)) 'big 4)
+            (bytevector-uint-ref b 0 'big 4))
+          #xFFFF0000)
+    (test (let ((b (make-bytevector 8 0)))
+            (bytevector-sint-set! b 0 (- (expt 256 2)) 'big 8)
+            (bytevector-uint-ref b 0 'big 8))
+          #xFFFFFFFFFFFF0000)
+    (test (let ((b (make-bytevector 8 0)))
+            (bytevector-sint-set! b 0 (- (expt 256 4)) 'big 8)
+            (bytevector-uint-ref b 0 'big 8))
+          #xFFFFFFFF00000000)
+    (test (let ((b (make-bytevector 8 0)))
+            (bytevector-sint-set! b 0 (- (expt 256 7)) 'big 8)
+            (bytevector-uint-ref b 0 'big 8))
+          #xFF00000000000000)
+    (test (let ((b (make-bytevector 8 0)))
+            (bytevector-sint-set! b 0 (- 1 (expt 2 63)) 'big 8)
+            (bytevector-sint-ref b 0 'big 8))
+          (- 1 (expt 2 63)))
+    (test (let ((b (make-bytevector 4 38)))
+            (bytevector-sint-set! b 0 (- (expt 2 31) 1) 'big 4)
+            (bytevector-sint-ref b 0 'big 4))
+          #x7FFFFFFF)
+    (test (let ((b (make-bytevector 4 38)))
+            (bytevector-sint-set! b 0 (- (expt 2 31)) 'big 4)
+            (bytevector-sint-ref b 0 'big 4))
+          #x-80000000)
+    (test (let ((b (make-bytevector 5 38)))
+            (bytevector-sint-set! b 0 (- (expt 2 32)) 'big 5)
+            (bytevector-sint-ref b 0 'big 5))
+          #x-100000000)
+    (test (bytevector-u16-ref '#vu8(255 253) 0 'little)
+          65023)
+    (test (bytevector-u16-ref '#vu8(255 253) 0 'big)
+          65533)
+    (test (bytevector-s16-ref '#vu8(255 253) 0 'little)
+          -513)
+    (test (bytevector-s16-ref '#vu8(255 253) 0 'big)
+          -3)
+    (test (let ((v (make-bytevector 2)))
+            (bytevector-u16-native-set! v 0 12345)
+            (bytevector-u16-native-ref v 0))
+          12345)
+    (test (let ((v (make-bytevector 2)))
+            (bytevector-u16-set! v 0 12345 'little)
+            (bytevector-u16-ref v 0 'little))
+          12345)
+    (test (let ((v (make-bytevector 2)))
+            (bytevector-u16-set! v 0 12345 'big)
+            (bytevector-u16-ref v 0 'big))
+          12345)

    ;;
    ))
-
-
-
--- a/collects/tests/r6rs/lists.ss
+++ b/collects/tests/r6rs/lists.ss
@ -6,6 +6,9 @@
          (tests r6rs test))

  (define (run-lists-tests)
+    
+    ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;;  Tests originally from R6RS

    (test (find even? '(3 1 4 1 5 9)) 4)
    (test (find even? '(3 1 5 1 5 9)) #f)
@ -105,5 +108,44 @@
    (test (cons* 1 2 3) '(1 2 . 3))
    (test (cons* 1) 1)

+    ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Tests originally from Ikarus
+
+    (test (for-all even? '(1 2 3 4)) #f)
+    (test (for-all even? '(10 12 14 16)) #t)
+    (test (for-all even? '(2 3 4)) #f)
+    (test (for-all even? '(12 14 16)) #t)
+    (test (for-all (lambda (x) x) '(12 14 16)) 16)
+    (test (for-all (lambda (x) x) '(12 14)) 14)
+    (test (for-all (lambda (x) x) '(12)) 12)
+    (test (for-all (lambda (x) x) '()) #t)
+    (test (for-all even? '(13 . 14)) #f)
+    (test (for-all cons '(1 2 3) '(a b c)) '(3 . c))
+    (test (for-all (lambda (a b) (= a 1)) '(1 2 3) '(a b c)) #f)
+    (test (for-all (lambda (a b) (= a 1)) '(1 2) '(a b c)) #f)
+    (test (fold-left + 0 '(1 2 3 4 5)) 15)
+    (test (fold-left (lambda (a b) (cons b a)) '() '(1 2 3 4 5))
+          '(5 4 3 2 1))
+    (test (fold-left (lambda (count x)
+                       (if (odd? x) 
+                           (+ count 1) 
+                           count))
+                     0 
+                     '(3 1 4 1 5 9 2 6 5 3))
+          7)
+    (test (fold-left cons '(q) '(a b c)) '((((q) . a) . b) . c))
+    (test (fold-left + 0 '(1 2 3) '(4 5 6)) 21)
+    (test (fold-right + 0 '(1 2 3 4 5)) 15)
+    (test (fold-right cons '() '(1 2 3 4 5))
+          '(1 2 3 4 5))
+    (test (fold-right (lambda (x l)
+                        (if (odd? x) 
+                            (cons x l)
+                            l))
+                      '()
+                      '(3 1 4 1 5 9 2 6 5 3))
+          '(3 1 1 5 9 5 3))
+    (test (fold-right + 0 '(1 2 3) '(4 5 6)) 21)
+
    ;;
    ))
--- a/collects/tests/r6rs/r5rs.ss
+++ b/collects/tests/r6rs/r5rs.ss
@ -58,6 +58,108 @@
    (test (begin (set! x 10)
                 (force p))      
          6)
+
+    ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;;  quotient, remainder, and modulo tests from Ikarus's
+    ;;  "bignums" test suite
+
+    (test (quotient 348972 3434)
+          101)
+    (test (quotient -348972 3434)
+          -101)
+    (test (quotient 348972 -3434)
+          -101)
+    (test (quotient -348972 -3434)
+          101)
+    (test (quotient 536870912 238)
+          2255760)
+    (test (quotient -536870912 238)
+          -2255760)
+    (test (quotient 536870912 -238)
+          -2255760)
+    (test (quotient -536870912 -238)
+          2255760)
+    (test (quotient 536870912238479837489374 324873)
+          1652556267336712615)
+    (test (quotient -536870912238479837489374 324873)
+          -1652556267336712615)
+    (test (quotient 536870912238479837489374 -324873)
+          -1652556267336712615)
+    (test (quotient -536870912238479837489374 -324873)
+          1652556267336712615)
+    (test (quotient 536870912238479837489374 3248732398479823749283)
+          165)
+    (test (quotient -536870912238479837489374 3248732398479823749283)
+          -165)
+    (test (quotient 536870912238479837489374 -3248732398479823749283)
+          -165)
+    (test (quotient -536870912238479837489374 -3248732398479823749283)
+          165)
+    (test (quotient 5368709122384798374893743894798327498234 3248732398479823749283)
+          1652555047284588078)
+    (test (quotient -5368709122384798374893743894798327498234 3248732398479823749283)
+          -1652555047284588078)
+    (test (quotient 5368709122384798374893743894798327498234 -3248732398479823749283)
+          -1652555047284588078)
+    (test (quotient -5368709122384798374893743894798327498234 -3248732398479823749283)
+          1652555047284588078)
+    (test (remainder 23 349839489348)
+          23)
+    (test (remainder -23 349839489348)
+          -23)
+    (test (remainder 23 -349839489348)
+          23)
+    (test (remainder -23 -349839489348)
+          -23)
+    (test (modulo 348972 3434)
+          2138)
+    (test (modulo -348972 3434)
+          1296)
+    (test (modulo 348972 -3434)
+          -1296)
+    (test (modulo -348972 -3434)
+          -2138)
+    (test (modulo -23 349839489348)
+          349839489325)
+    (test (modulo -23 -349839489348)
+          -23)
+    (test (modulo 23 349839489348)
+          23)
+    (test (modulo 23 -349839489348)
+          -349839489325)
+    (test (remainder 536870912 238)
+          32)
+    (test (remainder -536870912 238)
+          -32)
+    (test (remainder 536870912 -238)
+          32)
+    (test (remainder -536870912 -238)
+          -32)
+    (test (modulo 536870912 238)
+          32)
+    (test (modulo -536870912 238)
+          206)
+    (test (modulo 536870912 -238)
+          -206)
+    (test (modulo -536870912 -238)
+          -32)
+    (test (modulo 536870912238479837489374 324873)
+          116479)
+    (test (modulo -536870912238479837489374 324873)
+          208394)
+    (test (modulo 536870912238479837489374 -324873)
+          -208394)
+    (test (modulo -536870912238479837489374 -324873)
+          -116479)
+    (test (modulo 536870912238479837489374 3248732398479823749283)
+          830066489308918857679)
+    (test (modulo 536870912238479837489374 -3248732398479823749283)
+          -2418665909170904891604)
+    (test (modulo -536870912238479837489374 3248732398479823749283)
+          2418665909170904891604)
+    (test (modulo -536870912238479837489374 -3248732398479823749283)
+          -830066489308918857679)
+
    ;;
    ))

--- a/collects/tests/r6rs/run.ss
+++ b/collects/tests/r6rs/run.ss
@ -3,6 +3,7 @@
 (import (rnrs)
        (tests r6rs test)
        (tests r6rs base)
+        (tests r6rs reader)
        (tests r6rs unicode)
        (tests r6rs bytevectors)
        (tests r6rs lists)
@ -27,6 +28,7 @@

 (run-base-tests)

+(run-reader-tests)
 (run-unicode-tests)
 (run-bytevectors-tests)
 (run-lists-tests)
--- a/src/mzscheme/src/jit.c
+++ b/src/mzscheme/src/jit.c
@ -3180,7 +3180,9 @@ static int generate_arith(mz_jit_state *jitter, Scheme_Object *rator, Scheme_Obj
        } else if (arith == 11) {
          /* abs */
          jit_insn *refc;
-          refc = jit_bgti_l(jit_forward(), JIT_R0, (long)scheme_make_integer(0));
+          refc = jit_bgei_l(jit_forward(), JIT_R0, (long)scheme_make_integer(0));
+          /* watch out for most negative fixnum! */
+          (void)jit_beqi_p(refslow, JIT_R0, (void *)((1 << ((8 * JIT_WORD_SIZE) - 1)) | 0x1));
          jit_rshi_l(JIT_R0, JIT_R0, 1);
          jit_movi_l(JIT_R1, 0);
          jit_subr_l(JIT_R0, JIT_R1, JIT_R0);