;;; through the code this way. It would be nice to move this into the
;;; same file as the other RANDOM definitions.
(deftransform random ((num &optional state)
- ((integer 1 #.(expt 2 32)) &optional *))
+ ((integer 1 #.(expt 2 sb!vm::n-word-bits)) &optional *))
;; FIXME: I almost conditionalized this as #!+sb-doc. Find some way
;; of automatically finding #!+sb-doc in proximity to DEFTRANSFORM
;; to let me scan for places that I made this mistake and didn't
;; catch myself.
"use inline (UNSIGNED-BYTE 32) operations"
- (let ((type (lvar-type num)))
+ (let ((type (lvar-type num))
+ (limit (expt 2 sb!vm::n-word-bits))
+ (random-chunk (ecase sb!vm::n-word-bits
+ (32 'random-chunk)
+ (64 'sb!kernel::big-random-chunk))))
(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)))
+ (let ((rem (rem limit num-high)))
(unless (< (/ (* 2 rem (- num-high rem))
- num-high (expt 2 32))
+ num-high limit)
(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
+ (if (= num-high limit)
+ `(,random-chunk (or state *random-state*))
+ #!-(or x86 x86-64)
+ `(rem (,random-chunk (or state *random-state*)) num)
+ #!+(or x86 x86-64)
;; Use multiplication, which is faster.
- '(values (sb!bignum::%multiply
- (random-chunk (or state *random-state*))
+ `(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*))
+ #!+(or x86 x86-64)
+ ((< num-high limit)
+ `(values (sb!bignum::%multiply
+ (,random-chunk (or state *random-state*))
num)))
(t
- '(rem (random-chunk (or state *random-state*)) num))))
+ `(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.
(ex-hi (numeric-type-high ex))
(new-lo nil)
(new-hi nil))
- (when (and f-hi ex-hi)
- (setf new-hi (scale-bound f-hi ex-hi)))
- (when (and f-lo ex-lo)
- (setf new-lo (scale-bound f-lo ex-lo)))
+ (when f-hi
+ (if (< (float-sign (type-bound-number f-hi)) 0.0)
+ (when ex-lo
+ (setf new-hi (scale-bound f-hi ex-lo)))
+ (when ex-hi
+ (setf new-hi (scale-bound f-hi ex-hi)))))
+ (when f-lo
+ (if (< (float-sign (type-bound-number f-lo)) 0.0)
+ (when ex-hi
+ (setf new-lo (scale-bound f-lo ex-hi)))
+ (when ex-lo
+ (setf new-lo (scale-bound f-lo ex-lo)))))
(make-numeric-type :class (numeric-type-class f)
:format (numeric-type-format f)
:complexp :real
(etypecase arg
(numeric-type
(cond ((eq (numeric-type-complexp arg) :complex)
- (make-numeric-type :class (numeric-type-class arg)
- :format (numeric-type-format arg)
- :complexp :complex))
+ (complex-float-type arg))
((numeric-type-real-p arg)
;; The argument is real, so let's find the intersection
;; between the argument and the domain of the function.
nil nil))
#'tan))
-;;; CONJUGATE always returns the same type as the input type.
-;;;
-;;; FIXME: ANSI allows any subtype of REAL for the components of COMPLEX.
-;;; So what if the input type is (COMPLEX (SINGLE-FLOAT 0 1))?
(defoptimizer (conjugate derive-type) ((num))
- (lvar-type num))
+ (one-arg-derive-type num
+ (lambda (arg)
+ (flet ((most-negative-bound (l h)
+ (and l h
+ (if (< (type-bound-number l) (- (type-bound-number h)))
+ l
+ (set-bound (- (type-bound-number h)) (consp h)))))
+ (most-positive-bound (l h)
+ (and l h
+ (if (> (type-bound-number h) (- (type-bound-number l)))
+ h
+ (set-bound (- (type-bound-number l)) (consp l))))))
+ (if (numeric-type-real-p arg)
+ (lvar-type num)
+ (let ((low (numeric-type-low arg))
+ (high (numeric-type-high arg)))
+ (let ((new-low (most-negative-bound low high))
+ (new-high (most-positive-bound low high)))
+ (modified-numeric-type arg :low new-low :high new-high))))))
+ #'conjugate))
(defoptimizer (cis derive-type) ((num))
(one-arg-derive-type num
- (lambda (arg)
- (sb!c::specifier-type
- `(complex ,(or (numeric-type-format arg) 'float))))
- #'cis))
+ (lambda (arg)
+ (sb!c::specifier-type
+ `(complex ,(or (numeric-type-format arg) 'float))))
+ #'cis))
) ; PROGN
\f
projects / sbcl.git / blobdiff