diff --git a/compiler/sparc/array.lisp b/compiler/sparc/array.lisp
index 02b34cc863d26337a9fcdebb7ce3da965a628668..68ed99e6346662e20e43e1a97bdfbc06a32701e4 100644
--- a/compiler/sparc/array.lisp
+++ b/compiler/sparc/array.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/array.lisp,v 1.33 2006/06/30 18:41:32 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/array.lisp,v 1.34 2008/04/15 14:33:25 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -426,7 +426,7 @@
   (:result-types double-float)
   (:temporary (:scs (non-descriptor-reg)) offset)
   (:generator 7
-    (inst slln offset index 1)
+    (inst slln offset index (- 3 fixnum-tag-bits))
     (inst add offset (- (* vm:vector-data-offset vm:word-bytes)
 			vm:other-pointer-type))
     (inst lddf value object offset)))
@@ -442,7 +442,7 @@
   (:result-types double-float)
   (:temporary (:scs (non-descriptor-reg)) temp)
   (:generator 3
-    (let ((offset (+ (* index 8)
+    (let ((offset (+ (* index double-float-bytes)
 		     (- (* vm:vector-data-offset vm:word-bytes)
 			vm:other-pointer-type))))
       (if (typep offset '(signed-byte 13))
@@ -463,7 +463,7 @@
   (:result-types double-float)
   (:temporary (:scs (non-descriptor-reg)) offset)
   (:generator 20
-    (inst slln offset index 1)
+    (inst slln offset index (- 3 fixnum-tag-bits))
     (inst add offset (- (* vm:vector-data-offset vm:word-bytes)
 			vm:other-pointer-type))
     (inst stdf value object offset)
@@ -484,7 +484,7 @@
   (:result-types double-float)
   (:temporary (:scs (non-descriptor-reg)) temp)
   (:generator 10
-    (let ((offset (+ (* index 8)
+    (let ((offset (+ (* index double-float-bytes)
 		     (- (* vm:vector-data-offset vm:word-bytes)
 			vm:other-pointer-type))))
       (if (typep offset '(signed-byte 13))
@@ -604,12 +604,12 @@
   (:result-types complex-single-float)
   (:generator 5
     (let ((real-tn (complex-single-reg-real-tn value)))
-      (inst slln offset index 1)
+      (inst slln offset index (- 3 fixnum-tag-bits))
       (inst add offset (- (* vm:vector-data-offset vm:word-bytes)
 			  vm:other-pointer-type))
       (inst ldf real-tn object offset))
     (let ((imag-tn (complex-single-reg-imag-tn value)))
-      (inst add offset vm:word-bytes)
+      (inst add offset single-float-bytes)
       (inst ldf imag-tn object offset))))
 
 (define-vop (data-vector-ref-c/simple-array-complex-single-float)
@@ -624,18 +624,18 @@
   (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) temp)
   (:result-types complex-single-float)
   (:generator 3
-    (let ((offset (+ (* index 8)
+    (let ((offset (+ (* index (* 2 single-float-bytes))
 		     (- (* vm:vector-data-offset vm:word-bytes)
 			vm:other-pointer-type)))
 	  (real-tn (complex-single-reg-real-tn value))
 	  (imag-tn (complex-single-reg-imag-tn value)))
-      (cond ((typep (+ offset 4) '(signed-byte 13))
+      (cond ((typep (+ offset single-float-bytes) '(signed-byte 13))
 	     (inst ldf real-tn object offset)
-	     (inst ldf imag-tn object (+ offset 4)))
+	     (inst ldf imag-tn object (+ offset single-float-bytes)))
 	    (t
 	     (inst li temp offset)
 	     (inst ldf real-tn object temp)
-	     (inst add temp 4)
+	     (inst add temp single-float-bytes)
 	     (inst ldf imag-tn object temp))))))
 
 (define-vop (data-vector-set/simple-array-complex-single-float)
@@ -653,7 +653,7 @@
   (:generator 5
     (let ((value-real (complex-single-reg-real-tn value))
 	  (result-real (complex-single-reg-real-tn result)))
-      (inst slln offset index 1)
+      (inst slln offset index (- 3 fixnum-tag-bits))
       (inst add offset (- (* vm:vector-data-offset vm:word-bytes)
 			  vm:other-pointer-type))
       (inst stf value-real object offset)
@@ -661,7 +661,7 @@
 	(inst fmovs result-real value-real)))
     (let ((value-imag (complex-single-reg-imag-tn value))
 	  (result-imag (complex-single-reg-imag-tn result)))
-      (inst add offset vm:word-bytes)
+      (inst add offset single-float-bytes)
       (inst stf value-imag object offset)
       (unless (location= result-imag value-imag)
 	(inst fmovs result-imag value-imag)))))
@@ -680,20 +680,20 @@
   (:result-types complex-single-float)
   (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) temp)
   (:generator 3
-    (let ((offset (+ (* index 8)
+    (let ((offset (+ (* index (* 2 single-float-bytes))
 		     (- (* vm:vector-data-offset vm:word-bytes)
 			vm:other-pointer-type)))
 	  (value-real (complex-single-reg-real-tn value))
 	  (result-real (complex-single-reg-real-tn result))
 	  (value-imag (complex-single-reg-imag-tn value))
 	  (result-imag (complex-single-reg-imag-tn result)))
-      (cond ((typep (+ offset 4) '(signed-byte 13))
+      (cond ((typep (+ offset single-float-bytes) '(signed-byte 13))
 	     (inst stf value-real object offset)
-	     (inst stf value-imag object (+ offset 4)))
+	     (inst stf value-imag object (+ offset single-float-bytes)))
 	    (t
 	     (inst li temp offset)
 	     (inst stf value-real object temp)
-	     (inst add temp 4)
+	     (inst add temp single-float-bytes)
 	     (inst stf value-imag object temp)))
       (unless (location= result-real value-real)
 	(inst fmovs result-real value-real))
@@ -712,12 +712,12 @@
   (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
   (:generator 7
     (let ((real-tn (complex-double-reg-real-tn value)))
-      (inst slln offset index 2)
+      (inst slln offset index (- 4 fixnum-tag-bits))
       (inst add offset (- (* vm:vector-data-offset vm:word-bytes)
 			  vm:other-pointer-type))
       (inst lddf real-tn object offset))
     (let ((imag-tn (complex-double-reg-imag-tn value)))
-      (inst add offset (* 2 vm:word-bytes))
+      (inst add offset double-float-bytes)
       (inst lddf imag-tn object offset))))
 
 (define-vop (data-vector-ref-c/simple-array-complex-double-float)
@@ -731,18 +731,18 @@
   (:result-types complex-double-float)
   (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) temp)
   (:generator 5
-    (let ((offset (+ (* index 16)
+    (let ((offset (+ (* index (* 2 double-float-bytes))
 		     (- (* vm:vector-data-offset vm:word-bytes)
 			  vm:other-pointer-type)))
 	  (real-tn (complex-double-reg-real-tn value))
 	  (imag-tn (complex-double-reg-imag-tn value)))
-      (cond ((typep (+ offset 8) '(signed-byte 13))
+      (cond ((typep (+ offset double-float-bytes) '(signed-byte 13))
 	     (inst lddf real-tn object offset)
-	     (inst lddf imag-tn object (+ offset 8)))
+	     (inst lddf imag-tn object (+ offset double-float-bytes)))
 	    (t
 	     (inst li temp offset)
 	     (inst lddf real-tn object temp)
-	     (inst add temp (* 2 vm:word-bytes))
+	     (inst add temp double-float-bytes)
 	     (inst lddf imag-tn object temp))))))
 
 (define-vop (data-vector-set/simple-array-complex-double-float)
@@ -760,7 +760,7 @@
   (:generator 20
     (let ((value-real (complex-double-reg-real-tn value))
 	  (result-real (complex-double-reg-real-tn result)))
-      (inst slln offset index 2)
+      (inst slln offset index (- 4 fixnum-tag-bits))
       (inst add offset (- (* vm:vector-data-offset vm:word-bytes)
 			  vm:other-pointer-type))
       (inst stdf value-real object offset)
@@ -768,7 +768,7 @@
 	(move-double-reg result-real value-real)))
     (let ((value-imag (complex-double-reg-imag-tn value))
 	  (result-imag (complex-double-reg-imag-tn result)))
-      (inst add offset (* 2 vm:word-bytes))
+      (inst add offset double-float-bytes)
       (inst stdf value-imag object offset)
       (unless (location= result-imag value-imag)
 	(move-double-reg result-imag value-imag)))))
@@ -791,20 +791,20 @@
 	  (result-real (complex-double-reg-real-tn result))
 	  (value-imag (complex-double-reg-imag-tn value))
 	  (result-imag (complex-double-reg-imag-tn result))
-	  (offset (+ (* index 16)
+	  (offset (+ (* index (* 2 double-float-bytes))
 		     (- (* vm:vector-data-offset vm:word-bytes)
 			  vm:other-pointer-type))))
       ;; There's a possible optimization here if the offset for the
       ;; real part fits in a signed-byte 13 but the imag part doesn't.
       ;; We don't do this because it can't happen with the current
       ;; values of vm:other-pointer-type and vm:vector-data-offset.
-      (cond ((typep (+ offset 8) '(signed-byte 13))
+      (cond ((typep (+ offset double-float-bytes) '(signed-byte 13))
 	     (inst stdf value-real object offset)
-	     (inst stdf value-imag object (+ offset 8)))
+	     (inst stdf value-imag object (+ offset double-float-bytes)))
 	    (t
 	     (inst li temp offset)
 	     (inst stdf value-real object temp)
-	     (inst add temp 8)
+	     (inst add temp double-float-bytes)
 	     (inst stdf value-imag object temp)))
       (unless (location= result-real value-real)
 	(move-double-reg result-real value-real))
@@ -964,12 +964,12 @@
   (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
   (:generator 7
     (let ((hi-tn (double-double-reg-hi-tn value)))
-      (inst slln offset index 2)
+      (inst slln offset index (- 4 fixnum-tag-bits))
       (inst add offset (- (* vm:vector-data-offset vm:word-bytes)
 			  vm:other-pointer-type))
       (inst lddf hi-tn object offset))
     (let ((lo-tn (double-double-reg-lo-tn value)))
-      (inst add offset (* 2 vm:word-bytes))
+      (inst add offset double-float-bytes)
       (inst lddf lo-tn object offset))))
 
 (define-vop (data-vector-ref-c/simple-array-double-double-float)
@@ -983,18 +983,18 @@
   (:result-types double-double-float)
   (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) temp)
   (:generator 5
-    (let ((offset (+ (* index 16)
+    (let ((offset (+ (* index (* 2 double-float-bytes))
 		     (- (* vm:vector-data-offset vm:word-bytes)
 			  vm:other-pointer-type)))
 	  (hi-tn (double-double-reg-hi-tn value))
 	  (lo-tn (double-double-reg-lo-tn value)))
-      (cond ((typep (+ offset 8) '(signed-byte 13))
+      (cond ((typep (+ offset double-float-bytes) '(signed-byte 13))
 	     (inst lddf hi-tn object offset)
-	     (inst lddf lo-tn object (+ offset 8)))
+	     (inst lddf lo-tn object (+ offset double-float-bytes)))
 	    (t
 	     (inst li temp offset)
 	     (inst lddf hi-tn object temp)
-	     (inst add temp (* 2 vm:word-bytes))
+	     (inst add temp double-float-bytes)
 	     (inst lddf lo-tn object temp))))))
 
 (define-vop (data-vector-set/simple-array-double-double-float)
@@ -1012,7 +1012,7 @@
   (:generator 20
     (let ((value-hi (double-double-reg-hi-tn value))
 	  (result-hi (double-double-reg-hi-tn result)))
-      (inst slln offset index 2)
+      (inst slln offset index (- 4 fixnum-tag-bits))
       (inst add offset (- (* vm:vector-data-offset vm:word-bytes)
 			  vm:other-pointer-type))
       (inst stdf value-hi object offset)
@@ -1020,7 +1020,7 @@
 	(move-double-reg result-hi value-hi)))
     (let ((value-lo (double-double-reg-lo-tn value))
 	  (result-lo (double-double-reg-lo-tn result)))
-      (inst add offset (* 2 vm:word-bytes))
+      (inst add offset double-float-bytes)
       (inst stdf value-lo object offset)
       (unless (location= result-lo value-lo)
 	(move-double-reg result-lo value-lo)))))
@@ -1043,20 +1043,20 @@
 	  (result-hi (double-double-reg-hi-tn result))
 	  (value-lo (double-double-reg-lo-tn value))
 	  (result-lo (double-double-reg-lo-tn result))
-	  (offset (+ (* index 16)
+	  (offset (+ (* index (* 2 double-float-bytes))
 		     (- (* vm:vector-data-offset vm:word-bytes)
 			  vm:other-pointer-type))))
       ;; There's a possible optimization here if the offset for the
       ;; real part fits in a signed-byte 13 but the imag part doesn't.
       ;; We don't do this because it can't happen with the current
       ;; values of vm:other-pointer-type and vm:vector-data-offset.
-      (cond ((typep (+ offset 8) '(signed-byte 13))
+      (cond ((typep (+ offset double-float-bytes) '(signed-byte 13))
 	     (inst stdf value-hi object offset)
-	     (inst stdf value-lo object (+ offset 8)))
+	     (inst stdf value-lo object (+ offset double-float-bytes)))
 	    (t
 	     (inst li temp offset)
 	     (inst stdf value-hi object temp)
-	     (inst add temp 8)
+	     (inst add temp double-float-bytes)
 	     (inst stdf value-lo object temp)))
       (unless (location= result-hi value-hi)
 	(move-double-reg result-hi value-hi))
@@ -1075,18 +1075,18 @@
   (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
   (:generator 7
     (let ((real-tn (complex-double-double-reg-real-hi-tn value)))
-      (inst slln offset index 3)
+      (inst slln offset index (- 5 fixnum-tag-bits))
       (inst add offset (- (* vm:vector-data-offset vm:word-bytes)
 			  vm:other-pointer-type))
       (inst lddf real-tn object offset))
     (let ((real-tn (complex-double-double-reg-real-lo-tn value)))
-      (inst add offset (* 2 vm:word-bytes))
+      (inst add offset double-float-bytes)
       (inst lddf real-tn object offset))
     (let ((imag-tn (complex-double-double-reg-imag-hi-tn value)))
-      (inst add offset (* 2 vm:word-bytes))
+      (inst add offset double-float-bytes)
       (inst lddf imag-tn object offset))
     (let ((imag-tn (complex-double-double-reg-imag-lo-tn value)))
-      (inst add offset (* 2 vm:word-bytes))
+      (inst add offset double-float-bytes)
       (inst lddf imag-tn object offset))))
 
 (define-vop (data-vector-ref-c/simple-array-complex-double-double-float)
@@ -1100,26 +1100,26 @@
   (:result-types complex-double-double-float)
   (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) temp)
   (:generator 5
-    (let ((offset (+ (* index 16)
+    (let ((offset (+ (* index (* 2 double-float-bytes))
 		     (- (* vm:vector-data-offset vm:word-bytes)
 			  vm:other-pointer-type)))
 	  (real-hi-tn (complex-double-double-reg-real-hi-tn value))
 	  (imag-hi-tn (complex-double-double-reg-imag-hi-tn value))
 	  (real-lo-tn (complex-double-double-reg-real-lo-tn value))
 	  (imag-lo-tn (complex-double-double-reg-imag-lo-tn value)))
-      (cond ((typep (+ offset (* 6 vm:word-bytes)) '(signed-byte 13))
+      (cond ((typep (+ offset (* 3 double-float-bytes)) '(signed-byte 13))
 	     (inst lddf real-hi-tn object offset)
-	     (inst lddf real-lo-tn object (+ offset (* 2 vm:word-bytes)))
-	     (inst lddf imag-hi-tn object (+ offset (* 4 vm:word-bytes)))
-	     (inst lddf imag-lo-tn object (+ offset (* 6 vm:word-bytes))))
+	     (inst lddf real-lo-tn object (+ offset double-float-bytes))
+	     (inst lddf imag-hi-tn object (+ offset (* 2 double-float-bytes)))
+	     (inst lddf imag-lo-tn object (+ offset (* 3 double-float-bytes))))
 	    (t
 	     (inst li temp offset)
 	     (inst lddf real-hi-tn object temp)
-	     (inst add temp (* 2 vm:word-bytes))
+	     (inst add temp double-float-bytes)
 	     (inst lddf real-lo-tn object temp)
-	     (inst add temp (* 2 vm:word-bytes))
+	     (inst add temp double-float-bytes)
 	     (inst lddf imag-hi-tn object temp)
-	     (inst add temp (* 2 vm:word-bytes))
+	     (inst add temp double-float-bytes)
 	     (inst lddf imag-lo-tn object temp))))))
 
 (define-vop (data-vector-set/simple-array-complex-double-double-float)
@@ -1137,7 +1137,7 @@
   (:generator 20
     (let ((value-real (complex-double-double-reg-real-hi-tn value))
 	  (result-real (complex-double-double-reg-real-hi-tn result)))
-      (inst slln offset index 3)
+      (inst slln offset index (- 5 fixnum-tag-bits))
       (inst add offset (- (* vm:vector-data-offset vm:word-bytes)
 			  vm:other-pointer-type))
       (inst stdf value-real object offset)
@@ -1145,19 +1145,19 @@
 	(move-double-reg result-real value-real)))
     (let ((value-real (complex-double-double-reg-real-lo-tn value))
 	  (result-real (complex-double-double-reg-real-lo-tn result)))
-      (inst add offset (* 2 vm:word-bytes))
+      (inst add offset double-float-bytes)
       (inst stdf value-real object offset)
       (unless (location= result-real value-real)
 	(move-double-reg result-real value-real)))
     (let ((value-imag (complex-double-double-reg-imag-hi-tn value))
 	  (result-imag (complex-double-double-reg-imag-hi-tn result)))
-      (inst add offset (* 2 vm:word-bytes))
+      (inst add offset double-float-bytes)
       (inst stdf value-imag object offset)
       (unless (location= result-imag value-imag)
 	(move-double-reg result-imag value-imag)))
     (let ((value-imag (complex-double-double-reg-imag-lo-tn value))
 	  (result-imag (complex-double-double-reg-imag-lo-tn result)))
-      (inst add offset (* 2 vm:word-bytes))
+      (inst add offset double-float-bytes)
       (inst stdf value-imag object offset)
       (unless (location= result-imag value-imag)
 	(move-double-reg result-imag value-imag)))))
@@ -1180,20 +1180,20 @@
 	  (result-real (complex-double-double-reg-real-hi-tn result))
 	  (value-imag (complex-double-double-reg-imag-hi-tn value))
 	  (result-imag (complex-double-double-reg-imag-hi-tn result))
-	  (offset (+ (* index 16)
+	  (offset (+ (* index (* 2 double-float-bytes))
 		     (- (* vm:vector-data-offset vm:word-bytes)
-			  vm:other-pointer-type))))
+			vm:other-pointer-type))))
       ;; There's a possible optimization here if the offset for the
       ;; real part fits in a signed-byte 13 but the imag part doesn't.
       ;; We don't do this because it can't happen with the current
       ;; values of vm:other-pointer-type and vm:vector-data-offset.
-      (cond ((typep (+ offset 8) '(signed-byte 13))
+      (cond ((typep (+ offset double-float-bytes) '(signed-byte 13))
 	     (inst stdf value-real object offset)
-	     (inst stdf value-imag object (+ offset 8)))
+	     (inst stdf value-imag object (+ offset double-float-bytes)))
 	    (t
 	     (inst li temp offset)
 	     (inst stdf value-real object temp)
-	     (inst add temp 8)
+	     (inst add temp double-float-bytes)
 	     (inst stdf value-imag object temp)))
       (unless (location= result-real value-real)
 	(move-double-reg result-real value-real))
@@ -1203,20 +1203,20 @@
 	  (result-real (complex-double-double-reg-real-lo-tn result))
 	  (value-imag (complex-double-double-reg-imag-lo-tn value))
 	  (result-imag (complex-double-double-reg-imag-lo-tn result))
-	  (offset (+ (* index 16)
+	  (offset (+ (* index (* 2 double-float-bytes))
 		     (- (* vm:vector-data-offset vm:word-bytes)
-			  vm:other-pointer-type))))
+			vm:other-pointer-type))))
       ;; There's a possible optimization here if the offset for the
       ;; real part fits in a signed-byte 13 but the imag part doesn't.
       ;; We don't do this because it can't happen with the current
       ;; values of vm:other-pointer-type and vm:vector-data-offset.
-      (cond ((typep (+ offset (* 6 vm:word-bytes)) '(signed-byte 13))
-	     (inst stdf value-real object (+ offset (* 4 vm:word-bytes)))
-	     (inst stdf value-imag object (+ offset (* 6 vm:word-bytes))))
+      (cond ((typep (+ offset (* 3 double-float-bytes)) '(signed-byte 13))
+	     (inst stdf value-real object (+ offset (* 2 double-float-bytes)))
+	     (inst stdf value-imag object (+ offset (* 3 double-float-bytes))))
 	    (t
-	     (inst add temp 8)
+	     (inst add temp double-float-bytes)
 	     (inst stdf value-real object temp)
-	     (inst add temp 8)
+	     (inst add temp double-float-bytes)
 	     (inst stdf value-imag object temp)))
       (unless (location= result-real value-real)
 	(move-double-reg result-real value-real))
diff --git a/compiler/sparc/parms.lisp b/compiler/sparc/parms.lisp
index 56d532aaa37baa1de09e0fb5ca83d5f590ed6f30..9e883d90356179173ef6613f5a3e3ab7596a1310 100644
--- a/compiler/sparc/parms.lisp
+++ b/compiler/sparc/parms.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/parms.lisp,v 1.53 2007/07/25 16:06:00 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/parms.lisp,v 1.54 2008/04/15 14:33:25 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -57,12 +57,14 @@
 	  fixnum-tag-bits fixnum-tag-mask positive-fixnum-bits
 
 	  float-sign-shift
-	  
+
+	  single-float-bytes
 	  single-float-bias single-float-exponent-byte
 	  single-float-significand-byte single-float-normal-exponent-min
 	  single-float-normal-exponent-max single-float-hidden-bit
 	  single-float-trapping-nan-bit single-float-digits
 
+	  double-float-bytes
 	  double-float-bias double-float-exponent-byte
 	  double-float-significand-byte double-float-normal-exponent-min
 	  double-float-normal-exponent-max double-float-hidden-bit
@@ -116,6 +118,7 @@
 
 (defconstant float-sign-shift 31)
 
+(defconstant single-float-bytes 4)	; Bytes to hold a single-float
 (defconstant single-float-bias 126)
 (defconstant single-float-exponent-byte (byte 8 23))
 (defconstant single-float-significand-byte (byte 23 0))
@@ -124,6 +127,7 @@
 (defconstant single-float-hidden-bit (ash 1 23))
 (defconstant single-float-trapping-nan-bit (ash 1 22))
 
+(defconstant double-float-bytes 8)	; Bytes to hold a double-float
 (defconstant double-float-bias 1022)
 (defconstant double-float-exponent-byte (byte 11 20))
 (defconstant double-float-significand-byte (byte 20 0))