From f49bfb22b950ee41bdfd23de705fa023b3a9848c Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Thu, 2 Dec 2004 15:49:46 +0000 Subject: [PATCH] 0.8.17.15: Fix for RANDOM compilation (report PFD sbcl-devel 2004-11-30) --- NEWS | 3 ++ src/compiler/float-tran.lisp | 64 +++++++++++++++++++++++------------------- tests/compiler.pure.lisp | 8 ++++++ version.lisp-expr | 2 +- 4 files changed, 47 insertions(+), 30 deletions(-) diff --git a/NEWS b/NEWS index f22e243..5b1d40e 100644 --- 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 --- 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)))) ;;;; float accessors diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index d36c958..3bfaf65 100644 --- 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 --- 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" -- 1.7.10.4