diff --git a/code/exports.lisp b/code/exports.lisp
index c7e59f4edd2e395be32100377e330cf68fd5ba39..6f02e0dde6871dd2b065dce6f3d040ed9b73b9a0 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.140 1998/02/05 18:51:10 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.141 1998/02/19 10:52:10 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1242,8 +1242,9 @@
              "REMOVE-PORT-OBJECT" "REMOVE-XWINDOW-OBJECT"
              "RESOLVE-LOADED-ASSEMBLER-REFERENCES" "SAP+" "SAP-" "SAP-INT"
              "SAP-REF-16" "SAP-REF-32" "SAP-REF-8" "SAP-REF-DESCRIPTOR"
-             "SAP-REF-DOUBLE" "SAP-REF-SAP" "SAP-REF-SINGLE" "SAP<" "SAP<="
-             "SAP=" "SAP>" "SAP>=" "SCRUB-CONTROL-STACK" "SERVE-ALL-EVENTS"
+             "SAP-REF-DOUBLE" "SAP-REF-LONG" "SAP-REF-SAP" "SAP-REF-SINGLE"
+	     "SAP<" "SAP<=" "SAP=" "SAP>" "SAP>="
+	     "SCRUB-CONTROL-STACK" "SERVE-ALL-EVENTS"
              "SERVE-EVENT" "SERVER" "SERVER-MESSAGE" "SHORT-FLOAT-RADIX"
              "SIGNED-SAP-REF-16" "SIGNED-SAP-REF-32" "SIGNED-SAP-REF-8"
              "SINGLE-FLOAT-RADIX" "SYMBOL-MACRO-LET" "SYSTEM-AREA-POINTER"
diff --git a/code/sap.lisp b/code/sap.lisp
index 5bd6344c06a9afe6fa65520baad1629b8100f303..920a0148dd7235c91b59ae0b9cf042599587c2d0 100644
--- a/code/sap.lisp
+++ b/code/sap.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/sap.lisp,v 1.13 1997/04/25 20:49:42 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sap.lisp,v 1.14 1998/02/19 10:52:12 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -85,135 +85,164 @@
 (defun sap-ref-8 (sap offset)
   "Returns the 8-bit byte at OFFSET bytes from SAP."
   (declare (type system-area-pointer sap)
-	   #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset))
+	   #+(or x86 sparc) (fixnum offset)
+	   #-(or x86 sparc) (type index offset))
   (sap-ref-8 sap offset))
 
 (defun sap-ref-16 (sap offset)
   "Returns the 16-bit word at OFFSET bytes from SAP."
   (declare (type system-area-pointer sap)
-	   #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset))
+	   #+(or x86 sparc) (fixnum offset)
+	   #-(or x86 sparc) (type index offset))
   (sap-ref-16 sap offset))
 
 (defun sap-ref-32 (sap offset)
   "Returns the 32-bit dualword at OFFSET bytes from SAP."
   (declare (type system-area-pointer sap)
-	   #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset))
+	   #+(or x86 sparc) (fixnum offset)
+	   #-(or x86 sparc) (type index offset))
   (sap-ref-32 sap offset))
 
 #+alpha
 (defun sap-ref-64 (sap offset)
   "Returns the 64-bit quadword at OFFSET bytes from SAP."
   (declare (type system-area-pointer sap)
-	   #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset))
+	   #+(or x86 sparc) (fixnum offset)
+	   #-(or x86 sparc) (type index offset))
   (sap-ref-64 sap offset))
 
 (defun sap-ref-sap (sap offset)
   "Returns the 32-bit system-area-pointer at OFFSET bytes from SAP."
   (declare (type system-area-pointer sap)
-	   #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset))
+	   #+(or x86 sparc) (fixnum offset)
+	   #-(or x86 sparc) (type index offset))
   (sap-ref-sap sap offset))
 
 (defun sap-ref-single (sap offset)
   "Returns the 32-bit single-float at OFFSET bytes from SAP."
   (declare (type system-area-pointer sap)
-	   #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset))
+	   #+(or x86 sparc) (fixnum offset)
+	   #-(or x86 sparc) (type index offset))
   (sap-ref-single sap offset))
 
 (defun sap-ref-double (sap offset)
   "Returns the 64-bit double-float at OFFSET bytes from SAP."
   (declare (type system-area-pointer sap)
-	   #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset))
+	   #+(or x86 sparc) (fixnum offset)
+	   #-(or x86 sparc) (type index offset))
   (sap-ref-double sap offset))
 
+#+x86
+(defun sap-ref-long (sap offset)
+  "Returns the long-float at OFFSET bytes from SAP."
+  (declare (type system-area-pointer sap)
+	   (fixnum offset))
+  (sap-ref-long sap offset))
+
 (defun signed-sap-ref-8 (sap offset)
   "Returns the signed 8-bit byte at OFFSET bytes from SAP."
   (declare (type system-area-pointer sap)
-	   #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset))
+	   #+(or x86 sparc) (fixnum offset)
+	   #-(or x86 sparc) (type index offset))
   (signed-sap-ref-8 sap offset))
 
 (defun signed-sap-ref-16 (sap offset)
   "Returns the signed 16-bit word at OFFSET bytes from SAP."
   (declare (type system-area-pointer sap)
-	   #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset))
+	   #+(or x86 sparc) (fixnum offset)
+	   #-(or x86 sparc) (type index offset))
   (signed-sap-ref-16 sap offset))
 
 (defun signed-sap-ref-32 (sap offset)
   "Returns the signed 32-bit dualword at OFFSET bytes from SAP."
   (declare (type system-area-pointer sap)
-	   #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset))
+	   #+(or x86 sparc) (fixnum offset)
+	   #-(or x86 sparc) (type index offset))
   (signed-sap-ref-32 sap offset))
 
 #+alpha
 (defun signed-sap-ref-64 (sap offset)
   "Returns the signed 64-bit quadword at OFFSET bytes from SAP."
   (declare (type system-area-pointer sap)
-	   #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset))
+	   #+(or x86 sparc) (fixnum offset)
+	   #-(or x86 sparc) (type index offset))
   (signed-sap-ref-64 sap offset))
 
 (defun %set-sap-ref-8 (sap offset new-value)
   (declare (type system-area-pointer sap)
-	   #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
+	   #+(or x86 sparc) (fixnum offset)
+	   #-(or x86 sparc) (type index offset)
 	   (type (unsigned-byte 8) new-value))
   (setf (sap-ref-8 sap offset) new-value))
 
 (defun %set-sap-ref-16 (sap offset new-value)
   (declare (type system-area-pointer sap)
-	   #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
+	   #+(or x86 sparc) (fixnum offset)
+	   #-(or x86 sparc) (type index offset)
 	   (type (unsigned-byte 16) new-value))
   (setf (sap-ref-16 sap offset) new-value))
 
 (defun %set-sap-ref-32 (sap offset new-value)
   (declare (type system-area-pointer sap)
-	   #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
+	   #+(or x86 sparc) (fixnum offset)
+	   #-(or x86 sparc) (type index offset)
 	   (type (unsigned-byte 32) new-value))
   (setf (sap-ref-32 sap offset) new-value))
 
 #+alpha
 (defun %set-sap-ref-64 (sap offset new-value)
   (declare (type system-area-pointer sap)
-	   #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
+	   #+(or x86 sparc) (fixnum offset)
+	   #-(or x86 sparc) (type index offset)
 	   (type (unsigned-byte 64) new-value))
   (setf (sap-ref-64 sap offset) new-value))
 
 (defun %set-signed-sap-ref-8 (sap offset new-value)
   (declare (type system-area-pointer sap)
-	   #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
+	   #+(or x86 sparc) (fixnum offset)
+	   #-(or x86 sparc) (type index offset)
 	   (type (signed-byte 8) new-value))
   (setf (signed-sap-ref-8 sap offset) new-value))
 
 (defun %set-signed-sap-ref-16 (sap offset new-value)
   (declare (type system-area-pointer sap)
-	   #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
+	   #+(or x86 sparc) (fixnum offset)
+	   #-(or x86 sparc) (type index offset)
 	   (type (signed-byte 16) new-value))
   (setf (signed-sap-ref-16 sap offset) new-value))
 
 (defun %set-signed-sap-ref-32 (sap offset new-value)
   (declare (type system-area-pointer sap)
-	   #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
+	   #+(or x86 sparc) (fixnum offset)
+	   #-(or x86 sparc) (type index offset)
 	   (type (signed-byte 32) new-value))
   (setf (signed-sap-ref-32 sap offset) new-value))
 
 #+alpha
 (defun %set-signed-sap-ref-64 (sap offset new-value)
   (declare (type system-area-pointer sap)
-	   #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
+	   #+(or x86 sparc) (fixnum offset)
+	   #-(or x86 sparc) (type index offset)
 	   (type (signed-byte 64) new-value))
   (setf (signed-sap-ref-64 sap offset) new-value))
 
 (defun %set-sap-ref-sap (sap offset new-value)
   (declare (type system-area-pointer sap new-value)
-	   #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset))
+	   #+(or x86 sparc) (fixnum offset)
+	   #-(or x86 sparc) (type index offset))
   (setf (sap-ref-sap sap offset) new-value))
 
 (defun %set-sap-ref-single (sap offset new-value)
   (declare (type system-area-pointer sap)
-	   #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
+	   #+(or x86 sparc) (fixnum offset)
+	   #-(or x86 sparc) (type index offset)
 	   (type single-float new-value))
   (setf (sap-ref-single sap offset) new-value))
 
 (defun %set-sap-ref-double (sap offset new-value)
   (declare (type system-area-pointer sap)
-	   #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)
+	   #+(or x86 sparc) (fixnum offset)
+	   #-(or x86 sparc) (type index offset)
 	   (type double-float new-value))
   (setf (sap-ref-double sap offset) new-value))
 
diff --git a/code/x86-vm.lisp b/code/x86-vm.lisp
index 387f5ecf0941962767931d5702642d0d14cc7ab3..b870031ef9d9e0673863365aab7023b0e30d9cb9 100644
--- a/code/x86-vm.lisp
+++ b/code/x86-vm.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/x86-vm.lisp,v 1.12 1998/01/16 07:22:13 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/x86-vm.lisp,v 1.13 1998/02/19 10:52:13 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -293,8 +293,7 @@
       (#.edx-offset (slot scp 'sc-edx))
       (#.ebx-offset (slot scp 'sc-ebx))
       (#.esp-offset (slot scp 'sc-sp))
-#-linux      (#.ebp-offset (slot scp 'sc-fp))
-#+linux      (#.ebp-offset (slot scp 'ebp))
+      (#.ebp-offset (slot scp #-linux 'sc-fp #+linux 'ebp))
       (#.esi-offset (slot scp 'sc-esi))
       (#.edi-offset (slot scp 'sc-edi)))))
 
@@ -308,8 +307,7 @@
       (#.edx-offset (setf (slot scp 'sc-edx) new))
       (#.ebx-offset (setf (slot scp 'sc-ebx) new))
       (#.esp-offset (setf (slot scp 'sc-sp)  new))
-#-linux      (#.ebp-offset (setf (slot scp 'sc-fp)  new))
-#+linux      (#.ebp-offset (setf (slot scp 'ebp)  new))
+      (#.ebp-offset (setf (slot scp #-linux 'sc-fp #+linux 'ebp)  new))
       (#.esi-offset (setf (slot scp 'sc-esi) new))
       (#.edi-offset (setf (slot scp 'sc-edi) new))))
   new)
@@ -321,48 +319,23 @@
 ;;;
 ;;; Like SIGCONTEXT-REGISTER, but returns the value of a float register.
 ;;; Format is the type of float to return.
-;;; XXX
-#-linux
-(defun sigcontext-float-register (scp index format)
-  (declare (type (alien (* sigcontext)) scp))
-  (with-alien ((scp (* sigcontext) scp))
-    ;; fp regs not in sigcontext -- need new vop or c support
-    (let ((sap #+nil (alien-sap (slot scp 'sc-fpregs))))
-      (declare (ignore sap))
-      index
-      (ecase format
-	(single-float 0s0
-	 #+nil (system:sap-ref-single sap (* index vm:word-bytes)))
-	(double-float 0d0
-	 #+nil(system:sap-ref-double sap (* index vm:word-bytes)))))))
-
+;;;
 #+linux
 (defun sigcontext-float-register (scp index format)
   (declare (type (alien (* sigcontext)) scp))
   (with-alien ((scp (* sigcontext) scp))
-    ;; fp regs in sigcontext !!!
     (let ((reg-sap (alien-sap (deref (slot (deref (slot scp 'fpstate) 0)
-					    'fpreg)
+					   'fpreg)
 				     index))))
-      (ecase format
-        (single-float
-          (system:sap-ref-single reg-sap 0))
-        (double-float 
-          (system:sap-ref-double reg-sap 0))))))
+      (coerce (sys:sap-ref-long reg-sap 0) format))))
+
+;;; Not supported on FreeBSD because the floating point state is not
+;;; saved.
+#+FreeBSD
+(defun sigcontext-float-register (scp index format)
+  (declare (ignore scp index))
+  (coerce 0l0 format))
 
-;;;
-#-linux
-(defun %set-sigcontext-float-register (scp index format new-value)
-  (declare (type (alien (* sigcontext)) scp))
-  scp index format new-value
-  #+nil
-  (with-alien ((scp (* sigcontext) scp))
-    (let ((sap (alien-sap (slot scp 'fpregs))))
-      (ecase format
-	(single-float
-	 (setf (sap-ref-single sap (* index vm:word-bytes)) new-value))
-	(double-float
-	 (setf (sap-ref-double sap (* index vm:word-bytes)) new-value))))))
 #+linux
 (defun %set-sigcontext-float-register (scp index format new-value)
   (declare (type (alien (* sigcontext)) scp))
@@ -370,14 +343,17 @@
     (let ((reg-sap (alien-sap (deref (slot (deref (slot scp 'fpstate) 0)
 					    'fpreg)
 				     index))))
-      (ecase format
-        (single-float
-         (setf (system:sap-ref-single reg-sap 0) new-value))
-        (double-float
-         (setf (system:sap-ref-double reg-sap 0)new-value))))))
+      #+not-yet
+      (setf (sys:sap-ref-long reg-sap 0) (coerce new-value 'long-float))
+      (coerce new-value format))))
 
-;;;
+;;; Not supported on FreeBSD.
+#+FreeBSD
+(defun %set-sigcontext-float-register (scp index format new-value)
+  (declare (ignore scp index))
+  (coerce new-value format))
 
+;;;
 (defsetf sigcontext-float-register %set-sigcontext-float-register)
 
 ;;; SIGCONTEXT-FLOATING-POINT-MODES  --  Interface
diff --git a/compiler/saptran.lisp b/compiler/saptran.lisp
index c91ad5f95d36cd1fd683028dd907cc62871ffd22..d5cc5507ecc635f6a66cf65bc093f17c0879a86f 100644
--- a/compiler/saptran.lisp
+++ b/compiler/saptran.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/saptran.lisp,v 1.7 1997/04/25 20:49:43 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/saptran.lisp,v 1.8 1998/02/19 10:52:19 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -102,6 +102,9 @@
   (flushable))
 (defknown sap-ref-double (system-area-pointer #+(or x86 sparc) fixnum #-(or x86 sparc) index) double-float
   (flushable))
+#+x86
+(defknown sap-ref-long (system-area-pointer fixnum) long-float
+  (flushable))
 
 (defknown %set-sap-ref-single
 	  (system-area-pointer #+(or x86 sparc) fixnum #-(or x86 sparc) index single-float) single-float
@@ -138,7 +141,8 @@
 	       signed-sap-ref-32 %set-signed-sap-ref-32
 	       sap-ref-sap %set-sap-ref-sap
 	       sap-ref-single %set-sap-ref-single
-	       sap-ref-double %set-sap-ref-double))
+	       sap-ref-double %set-sap-ref-double
+	       #+x86 sap-ref-long))
   (deftransform fun ((sap offset) '* '* :eval-name t)
     (extract-function-args sap 'sap+ 2)
     `(lambda (sap offset1 offset2)
diff --git a/compiler/x86/sap.lisp b/compiler/x86/sap.lisp
index 30f8ac1e3bc993e1500fcacbd9ec1be64f59152e..7b64352df20ae1cee09c20659ab9ec3e4c2d1b9e 100644
--- a/compiler/x86/sap.lisp
+++ b/compiler/x86/sap.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/sap.lisp,v 1.6 1997/11/19 03:00:39 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/sap.lisp,v 1.7 1998/02/19 10:52:16 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -441,6 +441,32 @@
 			  (inst fst result))
 		  (inst fxch value)))))))
 
+
+;;; Sap-Ref-Long
+(define-vop (sap-ref-long)
+  (:translate sap-ref-long)
+  (:policy :fast-safe)
+  (:args (sap :scs (sap-reg))
+	 (offset :scs (signed-reg)))
+  (:arg-types system-area-pointer signed-num)
+  (:results (result :scs (#+long-float long-reg #-long-float double-reg)))
+  (:result-types #+long-float long-float #-long-float double-float)
+  (:generator 5
+     (with-empty-tn@fp-top(result)
+        (inst fldl (make-ea :dword :base sap :index offset)))))
+
+(define-vop (sap-ref-long-c)
+  (:translate sap-ref-long)
+  (:policy :fast-safe)
+  (:args (sap :scs (sap-reg)))
+  (:arg-types system-area-pointer (:constant (signed-byte 32)))
+  (:info offset)
+  (:results (result :scs (#+long-float long-reg #-long-float double-reg)))
+  (:result-types #+long-float long-float #-long-float double-float)
+  (:generator 4
+     (with-empty-tn@fp-top(result)
+        (inst fldl (make-ea :dword :base sap :disp offset)))))
+
 
 ;;; Noise to convert normal lisp data objects into SAPs.