X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsparc%2Ffloat.lisp;h=7751eb55648d84f75238fbd0cdfcd7c78c174ec2;hb=83543d4d5f876def7327969ec6ec40606e9e63f1;hp=5834443dc88a08046ccfd1c750b2850b7994f705;hpb=d323b0249b9b1e4a91ddf8716ac9185cd268d973;p=sbcl.git

diff --git a/src/compiler/sparc/float.lisp b/src/compiler/sparc/float.lisp
index 5834443..7751eb5 100644
--- a/src/compiler/sparc/float.lisp
+++ b/src/compiler/sparc/float.lisp
@@ -118,7 +118,7 @@
 (defun move-long-reg (dst src)
   (cond
     ((member :sparc-v9 *backend-subfeatures*)
-     (inst fmovq dst src)
+     (inst fmovq dst src))
     (t
      (dotimes (i 4)
        (let ((dst (make-random-tn :kind :normal
@@ -127,7 +127,7 @@
 	     (src (make-random-tn :kind :normal
 				  :sc (sc-or-lose 'single-reg)
 				  :offset (+ i (tn-offset src)))))
-	 (inst fmovs dst src)))))))
+	 (inst fmovs dst src))))))
 
 (macrolet ((frob (vop sc format)
 	     `(progn
@@ -158,15 +158,15 @@
   (:temporary (:scs (non-descriptor-reg)) ndescr)
   (:variant-vars format size type data)
   (:generator 13
-    (with-fixed-allocation (y ndescr type size))
-    (ecase format
-      (:single
-       (inst stf x y (- (* data n-word-bytes) other-pointer-lowtag)))
-      (:double
-       (inst stdf x y (- (* data n-word-bytes) other-pointer-lowtag)))
-      (:long
-       (store-long-reg x y (- (* data n-word-bytes)
-			      other-pointer-lowtag))))))
+    (with-fixed-allocation (y ndescr type size)
+      (ecase format
+        (:single
+         (inst stf x y (- (* data n-word-bytes) other-pointer-lowtag)))
+        (:double
+         (inst stdf x y (- (* data n-word-bytes) other-pointer-lowtag)))
+        (:long
+         (store-long-reg x y (- (* data n-word-bytes)
+                                other-pointer-lowtag)))))))
 
 (macrolet ((frob (name sc &rest args)
 	     `(progn
@@ -413,15 +413,15 @@
   (:note "complex single float to pointer coercion")
   (:generator 13
      (with-fixed-allocation (y ndescr complex-single-float-widetag
-			       complex-single-float-size))
-     (let ((real-tn (complex-single-reg-real-tn x)))
-       (inst stf real-tn y (- (* complex-single-float-real-slot
-				 n-word-bytes)
-			      other-pointer-lowtag)))
-     (let ((imag-tn (complex-single-reg-imag-tn x)))
-       (inst stf imag-tn y (- (* complex-single-float-imag-slot
-				 n-word-bytes)
-			      other-pointer-lowtag)))))
+			       complex-single-float-size)
+       (let ((real-tn (complex-single-reg-real-tn x)))
+         (inst stf real-tn y (- (* complex-single-float-real-slot
+                                   n-word-bytes)
+                                other-pointer-lowtag)))
+       (let ((imag-tn (complex-single-reg-imag-tn x)))
+         (inst stf imag-tn y (- (* complex-single-float-imag-slot
+                                   n-word-bytes)
+                                other-pointer-lowtag))))))
 ;;;
 (define-move-vop move-from-complex-single :move
   (complex-single-reg) (descriptor-reg))
@@ -433,15 +433,15 @@
   (:note "complex double float to pointer coercion")
   (:generator 13
      (with-fixed-allocation (y ndescr complex-double-float-widetag
-			       complex-double-float-size))
-     (let ((real-tn (complex-double-reg-real-tn x)))
-       (inst stdf real-tn y (- (* complex-double-float-real-slot
-				  n-word-bytes)
-			       other-pointer-lowtag)))
-     (let ((imag-tn (complex-double-reg-imag-tn x)))
-       (inst stdf imag-tn y (- (* complex-double-float-imag-slot
-				  n-word-bytes)
-			       other-pointer-lowtag)))))
+			       complex-double-float-size)
+       (let ((real-tn (complex-double-reg-real-tn x)))
+         (inst stdf real-tn y (- (* complex-double-float-real-slot
+                                    n-word-bytes)
+                                 other-pointer-lowtag)))
+       (let ((imag-tn (complex-double-reg-imag-tn x)))
+         (inst stdf imag-tn y (- (* complex-double-float-imag-slot
+                                    n-word-bytes)
+                                 other-pointer-lowtag))))))
 ;;;
 (define-move-vop move-from-complex-double :move
   (complex-double-reg) (descriptor-reg))
@@ -454,15 +454,15 @@
   (:note "complex long float to pointer coercion")
   (:generator 13
      (with-fixed-allocation (y ndescr complex-long-float-widetag
-			       complex-long-float-size))
-     (let ((real-tn (complex-long-reg-real-tn x)))
-       (store-long-reg real-tn y (- (* complex-long-float-real-slot
-				       n-word-bytes)
-				    other-pointer-lowtag)))
-     (let ((imag-tn (complex-long-reg-imag-tn x)))
-       (store-long-reg imag-tn y (- (* complex-long-float-imag-slot
-				       n-word-bytes)
-				    other-pointer-lowtag)))))
+			       complex-long-float-size)
+       (let ((real-tn (complex-long-reg-real-tn x)))
+         (store-long-reg real-tn y (- (* complex-long-float-real-slot
+                                         n-word-bytes)
+                                      other-pointer-lowtag)))
+       (let ((imag-tn (complex-long-reg-imag-tn x)))
+         (store-long-reg imag-tn y (- (* complex-long-float-imag-slot
+                                         n-word-bytes)
+                                      other-pointer-lowtag))))))
 ;;;
 #!+long-float
 (define-move-vop move-from-complex-long :move
@@ -1273,7 +1273,7 @@
       ;; The desired FP mode data is in the least significant 32
       ;; bits, which is stored at the next higher word in memory.
       (loadw res nfp (+ offset 4))
-      ;; Is this nop needed? (toy@rtp.ericsson.se)
+      ;; Is this nop needed? -- rtoy
       (inst nop))))
 
 (define-vop (set-floating-point-modes)
@@ -1314,7 +1314,7 @@
 	;; high 32 bits of the FSR, which contain the additional
 	;; %fcc's on the sparc V9.  If not, we don't need this, but we
 	;; do need to make sure that the unused bits are written as
-	;; zeroes, according the the V9 architecture manual.
+	;; zeroes, according the V9 architecture manual.
 	(inst sra new 0)
 	(inst srlx my-fsr 32)
 	(inst sllx my-fsr 32)
@@ -2396,14 +2396,14 @@
 (defun %%min (x y)
   (declare (type (or (unsigned-byte 32) (signed-byte 32)
 		     single-float double-float) x y))
-  (if (< x y)
+  (if (<= x y)
       x y))
 
 #+nil
 (defun %%max (x y)
   (declare (type (or (unsigned-byte 32) (signed-byte 32)
 		     single-float double-float) x y))
-  (if (> x y)
+  (if (>= x y)
       x y))
 #+nil  
 (macrolet
@@ -2510,7 +2510,7 @@
 ;;; expression since we don't have to do branches.
   
 (define-source-transform min (&rest args)
-  (if (member :sparc-v9 sb!vm:*backend-subfeatures*)
+  (if (member :sparc-v9 *backend-subfeatures*)
       (case (length args)
 	((0 2) (values nil t))
 	(1 `(values ,(first args)))
@@ -2518,7 +2518,7 @@
       (values nil t)))
 
 (define-source-transform max (&rest args)
-  (if (member :sparc-v9 sb!vm:*backend-subfeatures*)
+  (if (member :sparc-v9 *backend-subfeatures*)
       (case (length args)
 	((0 2) (values nil t))
 	(1 `(values ,(first args)))
@@ -2530,29 +2530,29 @@
   (multiple-value-bind (definitely-< definitely->=)
       (ir1-transform-<-helper x y)
     (cond (definitely-<
-	      (continuation-type y))
+	      (lvar-type y))
 	  (definitely->=
-	      (continuation-type x))
+	      (lvar-type x))
 	  (t
-	   (make-canonical-union-type (list (continuation-type x)
-					    (continuation-type y)))))))
+	   (make-canonical-union-type (list (lvar-type x)
+					    (lvar-type y)))))))
 
 (defoptimizer (min derive-type) ((x y))
-  (multiple-value-bind (definitely-< definitely->=)
-      (ir1-transform-<-helper x y)
-    (cond (definitely-<
-	      (continuation-type x))
-	  (definitely->=
-	      (continuation-type y))
+  (multiple-value-bind (definitely-> definitely-<=)
+      (ir1-transform-<-helper y x)
+    (cond (definitely-<=
+	      (lvar-type x))
+	  (definitely->
+	      (lvar-type y))
 	  (t
-	   (make-canonical-union-type (list (continuation-type x)
-					    (continuation-type y)))))))
+	   (make-canonical-union-type (list (lvar-type x)
+					    (lvar-type y)))))))
 
 (deftransform max ((x y) (number number) *)
-  (let ((x-type (continuation-type x))
-	(y-type (continuation-type y))
-	(signed (specifier-type '(signed-byte #.sb!vm:n-word-bits)))
-	(unsigned (specifier-type '(unsigned-byte #.sb!vm:n-word-bits)))
+  (let ((x-type (lvar-type x))
+	(y-type (lvar-type y))
+	(signed (specifier-type '(signed-byte #.n-word-bits)))
+	(unsigned (specifier-type '(unsigned-byte #.n-word-bits)))
 	(d-float (specifier-type 'double-float))
 	(s-float (specifier-type 'single-float)))
     ;; Use %%max if both args are good types of the same type.  As a
@@ -2575,14 +2575,14 @@
 		 (arg2 (gensym)))
 	     `(let ((,arg1 x)
 		    (,arg2 y))
-	       (if (> ,arg1 ,arg2)
+	       (if (>= ,arg1 ,arg2)
 		   ,arg1 ,arg2)))))))
 
 (deftransform min ((x y) (real real) *)
-  (let ((x-type (continuation-type x))
-	(y-type (continuation-type y))
-	(signed (specifier-type '(signed-byte #.sb!vm:n-word-bits)))
-	(unsigned (specifier-type '(unsigned-byte #.sb!vm:n-word-bits)))
+  (let ((x-type (lvar-type x))
+	(y-type (lvar-type y))
+	(signed (specifier-type '(signed-byte #.n-word-bits)))
+	(unsigned (specifier-type '(unsigned-byte #.n-word-bits)))
 	(d-float (specifier-type 'double-float))
 	(s-float (specifier-type 'single-float)))
     (cond ((and (csubtypep x-type signed)
@@ -2602,7 +2602,7 @@
 		 (arg2 (gensym)))
 	     `(let ((,arg1 x)
 		    (,arg2 y))
-		(if (< ,arg1 ,arg2)
+		(if (<= ,arg1 ,arg2)
 		    ,arg1 ,arg2)))))))
 
 ) ; PROGN