fixed a bug in quotient and div when given (least-fixnum) and -1.

scheme/ikarus.compiler.altcogen.ss

@@ -534,7 +534,7 @@
             (S (cadr rands)
                (lambda (s)
                  (make-asm-instr op d s))))]
-         [(remainder)
+         [(int-quotient)
           (S* rands
               (lambda (rands)
                 (seq* 
@@ -542,7 +542,7 @@
                   (make-asm-instr 'cltd edx eax)
                   (make-asm-instr 'idiv eax (cadr rands))
                   (make-set d eax))))]
-         [(quotient) 
+         [(int-remainder) 
           (S* rands
               (lambda (rands)
                 (seq* 
@@ -2308,9 +2308,12 @@
             (unless (symbol? a) 
               (error who "invalid arg to idiv"))
             (cond
-              [(disp? b)
+              [(or (var? b) (symbol? b)) x]
-               (error who "invalid arg to idiv" b)]
+              [else 
-              [else x])]
+               (let ([u (mku)])
+                 (make-seq
+                   (E (make-asm-instr 'move u b))
+                   (E (make-asm-instr 'idiv a u))))])]
            [(sll sra srl sll/overflow)
             (unless (or (constant? b)
                         (eq? b ecx))

scheme/ikarus.fixnums.ss

@@ -171,7 +171,11 @@
         (die 'fxquotient "not a fixnum" y))
       (when ($fxzero? y)
         (die 'fxquotient "zero dividend" y))
-      ($fxquotient x y))) 
+      (if (eq? y -1)
+          (if (eq? x (least-fixnum))
+              (die 'fxquotient "overflow" x y)
+              ($fx- 0 x))
+          ($fxquotient x y))))
   
   (define fxremainder
     (lambda (x y) 

scheme/ikarus.intel-assembler.ss

@@ -682,7 +682,7 @@
    [(idivl dst)
     (cond
       [(reg? dst)                       (CR* #xF7 '/7 dst ac)]
-      [(mem? dst)                         (CR* #xF7 '/7 dst ac)]
+      [(mem? dst)                       (CR* #xF7 '/7 dst ac)]
       [else (die who "invalid" instr)])]
    [(pushl dst)
     (cond

scheme/ikarus.numerics.ss

@@ -1632,6 +1632,15 @@
                 (string-append 
                   ($number->string xr r) (imag xi r) "i")]))]
           [else (die 'number->string "not a number" x)])))
+    (define do-warn
+      (lambda ()
+        (set! do-warn values)
+        (raise-continuable
+          (condition
+            (make-warning)
+            (make-who-condition 'number->string)
+            (make-message-condition 
+              "precision argument is not supported")))))
     (define number->string
       (case-lambda
         [(x) ($number->string x 10)]
@@ -1640,8 +1649,8 @@
            (die 'number->string "invalid radix" r))
          ($number->string x r)]
         [(x r precision)
-         (die 'number->string 
+         ;(do-warn)
-            "BUG: precision is not supported yet")])))
+         (number->string x r)])))
 
   (define modulo
     (lambda (n m)
@@ -2412,8 +2421,9 @@
         [(fixnum? x) 
          (cond
            [(fixnum? y)
-            (values (fxquotient x y)
+            (if (eq? y -1)
-                    (fxremainder x y))]
+                (values (- x) 0)
+                (values (fxquotient x y) (fxremainder x y)))]
            [(bignum? y) (values 0 x)]
            [(flonum? y) 
             (let ([v ($flonum->exact y)])
@@ -3235,6 +3245,7 @@
       [(and (fixnum? n) (fixnum? m)) 
        (cond
          [(eq? m 0) (error 'div "division by 0")]
+         [(eq? m -1) (- n)]
          [else 
           (let ([d0 ($fxquotient n m)])
             (if ($fx>= n ($fx* d0 m))

scheme/last-revision

@@ -1 +1 @@
-1553
+1554

scheme/makefile.ss

@@ -495,6 +495,8 @@
     [$fxsra                                      $fx]
     [$fxquotient                                 $fx]
     [$fxmodulo                                   $fx]
+    [$int-quotient                               $fx]
+    [$int-remainder                              $fx]
     [$fxlogxor                                   $fx]
     [$fxlogor                                    $fx]
     [$fxlognot                                   $fx]

scheme/pass-specify-rep-primops.ss

@@ -896,18 +896,24 @@
 (define-primop $fxquotient unsafe
   [(V a b) 
    (with-tmp ([b (T b)]) ;;; FIXME: why is quotient called remainder?
-    (prm 'sll (prm 'remainder (T a) b) (K fx-shift)))]
+    (prm 'sll (prm 'int-quotient (T a) b) (K fx-shift)))]
   [(P a b) (K #t)]
   [(E a b) (nop)])
 
+(define-primop $int-quotient unsafe
+  [(V a b)
+   (prm 'sll (prm 'int-quotient (T a) (T b)) (K fx-shift))])
+
+(define-primop $int-remainder unsafe
+  [(V a b) (prm 'int-remainder (T a))])
 
 (define-primop $fxmodulo unsafe
   [(V a b)
-   (with-tmp ([b (T b)]) ;;; FIXME: why is modulo called quotient?
+   (with-tmp ([b (T b)]) 
      (with-tmp ([c (prm 'logand b 
                       (prm 'sra (prm 'logxor b (T a))
                          (K (sub1 (* 8 wordsize)))))])
-       (prm 'int+ c (prm 'quotient (T a) b))))]
+       (prm 'int+ c (prm 'int-remainder (T a) b))))]
   [(P a b) (K #t)]
   [(E a b) (nop)])
 

scheme/psyntax.expander.ss

@@ -1722,12 +1722,15 @@
              (let-values (((lhs* rhs* q) (quasi q lev)))
                (if (= lev 0)
                    (let ((g (gensym)))
-                     (values (cons `(,g ...) lhs*) (cons p rhs*)
+                     (values 
-                        `(,g ... . ,q)))
+                       (cons `(,g ...) lhs*)
+                       (cons p rhs*)
+                       `(,g ... . ,q)))
                    (let-values (((lhs2* rhs2* p) (quasi p (- lev 1))))
-                     (values (append lhs2* lhs*)
+                     (values 
-                             (append rhs2* rhs*)
+                       (append lhs2* lhs*)
-                             `((unsyntax-splicing ,p) . ,q))))))
+                       (append rhs2* rhs*)
+                       `((unsyntax-splicing ,p) . ,q))))))
             (unsyntax-splicing (= lev 0)
              (stx-error p "incorrect use of unsyntax-splicing"))
             ((quasisyntax p)

scheme/tests/div-and-mod.ss

@@ -40,7 +40,10 @@
     (test +3 -7/11)
     (test -3 -7/11)
 
-
+    (test (least-fixnum) -1)
+    (test (least-fixnum) 1)
+    (test (greatest-fixnum) -1)
+    (test (greatest-fixnum) 1)
 
 
     )