diff --git a/code/exports.lisp b/code/exports.lisp
index 6aafd0fbd8acdff4236526e8e998f16a289d99b3..1c9ced22beb29633d6c2459ea81652617543631e 100644
--- a/code/exports.lisp
+++ b/code/exports.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/code/exports.lisp,v 1.217 2003/06/26 13:27:42 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.218 2003/07/02 21:45:33 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1885,7 +1885,9 @@
 	   "DATA-VECTOR-REF" "DATA-VECTOR-SET" "DECODE-DOUBLE-FLOAT"
 	   "DECODE-LONG-FLOAT" "DECODE-SINGLE-FLOAT" "DESCEND-INTO"
 	   "DIVISION-BY-ZERO-ERROR"
-	   "DOUBLE-FLOAT-EXPONENT" "DOUBLE-FLOAT-HIGH-BITS"
+	   "DOUBLE-FLOAT-EXPONENT"
+	   #+sparc "DOUBLE-FLOAT-BITS"
+	   "DOUBLE-FLOAT-HIGH-BITS"
 	   "DOUBLE-FLOAT-LOW-BITS" "DOUBLE-FLOAT-P" "FLOAT-WAIT"
 	   "DYNAMIC-SPACE-FREE-POINTER" "ERROR-NUMBER-OR-LOSE" "FILENAME"
 	   "FLOAT-DIGITS" "FLOAT-EXPONENT" "FLOAT-FORMAT-DIGITS"
diff --git a/code/kernel.lisp b/code/kernel.lisp
index 71e1eba13d643345992ec2767518a9be9c3c5a11..a286ea270079d54cb57835464beac5b8b74f98bf 100644
--- a/code/kernel.lisp
+++ b/code/kernel.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/code/kernel.lisp,v 1.12 1998/03/21 08:11:58 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/kernel.lisp,v 1.13 2003/07/02 21:45:33 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -152,3 +152,10 @@
 (defun long-float-mid-bits (x) (long-float-mid-bits x))
 #+long-float
 (defun long-float-low-bits (x) (long-float-low-bits x))
+
+#+sparc
+(defun double-float-bits (x) (double-float-bits x))
+
+#-sparc
+(defun double-float-bits (x)
+  (values (double-float-high-bits x) (double-float-low-bits x)))
diff --git a/compiler/float-tran.lisp b/compiler/float-tran.lisp
index 64ddee487d64f46b32a6676d8495cfabfa3074c8..d63f30f2ef243ba30679ef7ddd680e101426b866 100644
--- a/compiler/float-tran.lisp
+++ b/compiler/float-tran.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/float-tran.lisp,v 1.88 2003/04/23 20:05:05 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.89 2003/07/02 21:45:33 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -222,6 +222,12 @@
 (defknown double-float-low-bits (double-float) (unsigned-byte 32)
   (movable foldable flushable))
 
+#+sparc
+(defknown double-float-bits (double-float)
+  (values (signed-byte 32) (unsigned-byte 32))
+  (movable foldable flushable))
+
+
 (deftransform float-sign ((float &optional float2)
 			  (single-float &optional single-float) *)
   (if float2
diff --git a/compiler/sparc/float.lisp b/compiler/sparc/float.lisp
index faca965fcc71ea2d71c0e55e6df53ee371d51c86..11898b67d46c81c716273c3746981b9bdbaee5c6 100644
--- a/compiler/sparc/float.lisp
+++ b/compiler/sparc/float.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/float.lisp,v 1.38 2003/04/01 21:22:20 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/float.lisp,v 1.39 2003/07/02 21:45:34 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1179,6 +1179,37 @@
        (loadw lo-bits float (1+ vm:double-float-value-slot)
 	      vm:other-pointer-type)))))
 
+(define-vop (double-float-bits)
+  (:args (float :scs (double-reg descriptor-reg)
+		:load-if (not (sc-is float double-stack))))
+  (:results (hi-bits :scs (signed-reg))
+	    (lo-bits :scs (unsigned-reg)))
+  (:temporary (:scs (double-stack)) stack-temp)
+  (:arg-types double-float)
+  (:result-types signed-num unsigned-num)
+  (:translate kernel::double-float-bits)
+  (:policy :fast-safe)
+  (:vop-var vop)
+  (:generator 5
+    (sc-case float
+      (double-reg
+       (inst stdf float (current-nfp-tn vop)
+	     (* (tn-offset stack-temp) vm:word-bytes))
+       (inst ld hi-bits (current-nfp-tn vop)
+	     (* (tn-offset stack-temp) vm:word-bytes))
+       (inst ld lo-bits (current-nfp-tn vop)
+	     (* (1+ (tn-offset stack-temp)) vm:word-bytes)))
+      (double-stack
+       (inst ld hi-bits (current-nfp-tn vop)
+	     (* (tn-offset stack-temp) vm:word-bytes))
+       (inst ld lo-bits (current-nfp-tn vop)
+	     (* (1+ (tn-offset float)) vm:word-bytes)))
+      (descriptor-reg
+       (loadw hi-bits float vm:double-float-value-slot
+	      vm:other-pointer-type)
+       (loadw lo-bits float (1+ vm:double-float-value-slot)
+	      vm:other-pointer-type)))))
+
 #+long-float
 (define-vop (long-float-exp-bits)
   (:args (float :scs (long-reg descriptor-reg)