X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ffloat-tran.lisp;h=9e6033c1e9680b200480280b45707b8ecd7df917;hb=69d60b456b07a0256f08df0d02484f361ce5737c;hp=c3c811d9e8ab6356068c87f2b1df949ccae46552;hpb=f49bfb22b950ee41bdfd23de705fa023b3a9848c;p=sbcl.git

diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp
index c3c811d..9e6033c 100644
--- a/src/compiler/float-tran.lisp
+++ b/src/compiler/float-tran.lisp
@@ -50,43 +50,48 @@
 ;;; 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.
@@ -233,10 +238,18 @@
 	    (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
@@ -619,9 +632,7 @@
   (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.
@@ -1292,19 +1303,34 @@
 			   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