0.8.17.15:

	Fix for RANDOM compilation (report PFD sbcl-devel 2004-11-30)

diff --git a/NEWS b/NEWS
index f22e243..5b1d40e 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -13,6 +13,9 @@ changes in sbcl-0.8.18 relative to sbcl-0.8.17:
   * bug fix: as specified by AMOP, an error is signalled if a
     class-option appears multiple times in a DEFCLASS form. (reported
     by Bruno Haible)
+  * bug fix: RANDOM can be compiled when the compiler derives the type
+    of its numeric argument as a disjoint set of small integers.
+    (reported by Paul Dietz)
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** INCF, DECF and REMF evaluate their place form as specified in
        CLtS 5.1.3.

diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp
index ec1fabf..c3c811d 100644 (file)
--- a/src/compiler/float-tran.lisp
+++ b/src/compiler/float-tran.lisp
@@ -56,35 +56,41 @@
   ;; to let me scan for places that I made this mistake and didn't
   ;; catch myself.
   "use inline (UNSIGNED-BYTE 32) operations"
-  (let ((num-high (numeric-type-high (lvar-type num))))
-    (when (null num-high)
-      (give-up-ir1-transform))
-    (cond ((constant-lvar-p num)
-          ;; Check the worst case sum absolute error for the random number
-          ;; expectations.
-          (let ((rem (rem (expt 2 32) num-high)))
-            (unless (< (/ (* 2 rem (- num-high rem)) num-high (expt 2 32))
-                       (expt 2 (- sb!kernel::random-integer-extra-bits)))
-              (give-up-ir1-transform
-               "The random number expectations are inaccurate."))
-            (if (= num-high (expt 2 32))
-                '(random-chunk (or state *random-state*))
-                #!-x86 '(rem (random-chunk (or state *random-state*)) num)
-                #!+x86
-                ;; Use multiplication, which is faster.
-                '(values (sb!bignum::%multiply
-                          (random-chunk (or state *random-state*))
-                          num)))))
-         ((> num-high random-fixnum-max)
-          (give-up-ir1-transform
-           "The range is too large to ensure an accurate result."))
-         #!+x86
-         ((< num-high (expt 2 32))
-          '(values (sb!bignum::%multiply (random-chunk (or state
-                                                           *random-state*))
-                    num)))
-         (t
-          '(rem (random-chunk (or state *random-state*)) num)))))
+  (let ((type (lvar-type num)))
+    (if (numeric-type-p type)
+        (let ((num-high (numeric-type-high (lvar-type num))))
+          (aver num-high)
+          (cond ((constant-lvar-p num)
+                 ;; Check the worst case sum absolute error for the
+                 ;; random number expectations.
+                 (let ((rem (rem (expt 2 32) num-high)))
+                   (unless (< (/ (* 2 rem (- num-high rem))
+                                 num-high (expt 2 32))
+                              (expt 2 (- sb!kernel::random-integer-extra-bits)))
+                     (give-up-ir1-transform
+                      "The random number expectations are inaccurate."))
+                   (if (= num-high (expt 2 32))
+                       '(random-chunk (or state *random-state*))
+                       #!-x86 '(rem (random-chunk (or state *random-state*)) num)
+                       #!+x86
+                       ;; Use multiplication, which is faster.
+                       '(values (sb!bignum::%multiply
+                                 (random-chunk (or state *random-state*))
+                                 num)))))
+                ((> num-high random-fixnum-max)
+                 (give-up-ir1-transform
+                  "The range is too large to ensure an accurate result."))
+                #!+x86
+                ((< num-high (expt 2 32))
+                 '(values (sb!bignum::%multiply
+                           (random-chunk (or state *random-state*))
+                           num)))
+                (t
+                 '(rem (random-chunk (or state *random-state*)) num))))
+        ;; KLUDGE: a relatively conservative treatment, but better
+        ;; than a bug (reported by PFD sbcl-devel towards the end of
+        ;; 2004-11.
+        '(rem (random-chunk (or state *random-state*)) num))))
 \f
 ;;;; float accessors
 

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index d36c958..3bfaf65 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -1648,3 +1648,11 @@
   (multiple-value-bind (res err) (ignore-errors (funcall fun))
     (assert (not res))
     (assert (typep err 'program-error))))
+
+(let ((fun (compile nil '(lambda (x) (random (if x 10 20))))))
+  (dotimes (i 100 (error "bad RANDOM distribution"))
+    (when (> (funcall fun nil) 9)
+      (return t)))
+  (dotimes (i 100)
+    (when (> (funcall fun t) 9)
+      (error "bad RANDOM event"))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 7620d00..ef20f2f 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.17.14"
+"0.8.17.15"