diff --git a/compiler/x86/float.lisp b/compiler/x86/float.lisp
index 3b831238dca6f2e46c51baa5798844d4a49988e5..5c44549ca5f7da299b553d93c3b6ad9336aac06a 100644
--- a/compiler/x86/float.lisp
+++ b/compiler/x86/float.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/float.lisp,v 1.22 1998/02/21 18:24:46 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float.lisp,v 1.23 1998/02/24 18:10:17 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -333,20 +333,23 @@
 ;;;
 ;;; Move from a descriptor to a float register
 ;;;
-(macrolet ((frob (name sc double-p)
-	     `(progn
-		(define-vop (,name)
-		  (:args (x :scs (descriptor-reg)))
-		  (:results (y :scs (,sc)))
-		  (:note "pointer to float coercion")
-		  (:generator 2
-		     (with-empty-tn@fp-top(y)
-		       ,@(if double-p
-			     '((inst fldd (ea-for-df-desc x)))
-			   '((inst fld  (ea-for-sf-desc x)))))))
-		(define-move-vop ,name :move (descriptor-reg) (,sc)))))
-	  (frob move-to-single single-reg nil)
-	  (frob move-to-double double-reg   t))
+(define-vop (move-to-single)
+  (:args (x :scs (descriptor-reg)))
+  (:results (y :scs (single-reg)))
+  (:note "pointer to float coercion")
+  (:generator 2
+     (with-empty-tn@fp-top(y)
+       (inst fld (ea-for-sf-desc x)))))
+(define-move-vop move-to-single :move (descriptor-reg) (single-reg))
+
+(define-vop (move-to-double)
+  (:args (x :scs (descriptor-reg)))
+  (:results (y :scs (double-reg)))
+  (:note "pointer to float coercion")
+  (:generator 2
+     (with-empty-tn@fp-top(y)
+       (inst fldd (ea-for-df-desc x)))))
+(define-move-vop move-to-double :move (descriptor-reg) (double-reg))
 
 
 #+complex-float
@@ -392,7 +395,7 @@
 ;;;
 ;;; Move from a descriptor to a complex float register
 ;;;
-(macrolet ((frob (name sc double-p)
+(macrolet ((frob (name sc format)
 	     `(progn
 		(define-vop (,name)
 		  (:args (x :scs (descriptor-reg)))
@@ -401,17 +404,17 @@
 		  (:generator 2
 		    (let ((real-tn (complex-double-reg-real-tn y)))
 		      (with-empty-tn@fp-top(real-tn)
-			,@(if double-p
-			      '((inst fldd (ea-for-cdf-real-desc x)))
-			      '((inst fld (ea-for-csf-real-desc x))))))
+			,@(ecase format
+			   (:single '((inst fld (ea-for-csf-real-desc x))))
+			   (:double '((inst fldd (ea-for-cdf-real-desc x)))))))
 		    (let ((imag-tn (complex-double-reg-imag-tn y)))
 		      (with-empty-tn@fp-top(imag-tn)
-			,@(if double-p
-			      '((inst fldd (ea-for-cdf-imag-desc x)))
-			      '((inst fld (ea-for-csf-imag-desc x))))))))
+			,@(ecase format
+			   (:single '((inst fld (ea-for-csf-imag-desc x))))
+			   (:double '((inst fldd (ea-for-cdf-imag-desc x)))))))))
 		(define-move-vop ,name :move (descriptor-reg) (,sc)))))
-	  (frob move-to-complex-single complex-single-reg nil)
-	  (frob move-to-complex-double complex-double-reg t))
+	  (frob move-to-complex-single complex-single-reg :single)
+	  (frob move-to-complex-double complex-double-reg :double))
 ) ; complex-float
 
 
@@ -422,7 +425,7 @@
 ;;; so the order is different than the lisp-stack.
 
 ;;; The general move-argument vop
-(macrolet ((frob (name sc stack-sc double-p)
+(macrolet ((frob (name sc stack-sc format)
 	     `(progn
 		(define-vop (,name)
 		  (:args (x :scs (,sc) :target y)
@@ -430,7 +433,7 @@
 			     :load-if (not (sc-is y ,sc))))
 		  (:results (y))
 		  (:note "float argument move")
-		  (:generator ,(if double-p 3 2)
+		  (:generator ,(case format (:single 2) (:double 3))
 		    (sc-case y
 		      (,sc
 		       (unless (location= x y)
@@ -447,26 +450,28 @@
 			   (let* ((offset (* (tn-offset y) word-bytes))
 				  (ea (make-ea :dword :base fp :disp offset)))
 			     (with-tn@fp-top(x)
-					    ,@(if double-p
-						  '((inst fstd ea))
-						'((inst fst  ea)))))
-			 (let ((ea (make-ea
-				    :dword :base fp
-				    :disp (- (* (+ (tn-offset y)
-						   ,(if double-p 2 1))
-						vm:word-bytes)))))
-			   (with-tn@fp-top(x)
-					  ,@(if double-p
-						'((inst fstd ea))
-					      '((inst fst  ea))))))))))
+				,@(ecase format
+					 (:single '((inst fst ea)))
+					 (:double '((inst fstd ea))))))
+			   (let ((ea (make-ea
+				      :dword :base fp
+				      :disp (- (* (+ (tn-offset y)
+						     ,(case format
+							    (:single 1)
+							    (:double 2)))
+						  vm:word-bytes)))))
+			     (with-tn@fp-top(x)
+			       ,@(ecase format 
+				    (:single '((inst fst  ea)))
+				    (:double '((inst fstd ea)))))))))))
 		(define-move-vop ,name :move-argument
 		  (,sc descriptor-reg) (,sc)))))
-  (frob move-single-float-argument single-reg single-stack nil)
-  (frob move-double-float-argument double-reg double-stack t))
+  (frob move-single-float-argument single-reg single-stack :single)
+  (frob move-double-float-argument double-reg double-stack :double))
 
 ;;;; Complex float move-argument vop
 #+complex-float
-(macrolet ((frob (name sc stack-sc double-p)
+(macrolet ((frob (name sc stack-sc format)
 	     `(progn
 		(define-vop (,name)
 		  (:args (x :scs (,sc) :target y)
@@ -474,7 +479,7 @@
 			     :load-if (not (sc-is y ,sc))))
 		  (:results (y))
 		  (:note "complex float argument move")
-		  (:generator ,(if double-p 3 2)
+		  (:generator ,(ecase format (:single 2) (:double 3))
 		    (sc-case y
 		      (,sc
 		       (unless (location= x y)
@@ -496,27 +501,33 @@
 		      (,stack-sc
 		       (let ((real-tn (complex-double-reg-real-tn x)))
 			 (cond ((zerop (tn-offset real-tn))
-				,@(if double-p
-				      '((inst fstd (ea-for-cdf-real-stack y)))
-				      '((inst fst (ea-for-csf-real-stack y)))))
+				,@(ecase format
+				    (:single
+				     '((inst fst (ea-for-csf-real-stack y))))
+				    (:double
+				     '((inst fstd (ea-for-cdf-real-stack y))))))
 			       (t
 				(inst fxch real-tn)
-				,@(if double-p
-				      '((inst fstd (ea-for-cdf-real-stack y)))
-				      '((inst fst (ea-for-csf-real-stack y))))
+				,@(ecase format
+				    (:single
+				     '((inst fst (ea-for-csf-real-stack y))))
+				    (:double
+				     '((inst fstd (ea-for-cdf-real-stack y)))))
 				(inst fxch real-tn))))
 		       (let ((imag-tn (complex-double-reg-imag-tn x)))
 			 (inst fxch imag-tn)
-			 ,@(if double-p
-			       '((inst fstd (ea-for-cdf-imag-stack y)))
-			       '((inst fst (ea-for-csf-imag-stack y))))
+			 ,@(ecase format
+			     (:single
+			      '((inst fst (ea-for-csf-imag-stack y))))
+			     (:double
+			      '((inst fstd (ea-for-cdf-imag-stack y)))))
 			 (inst fxch imag-tn))))))
 		(define-move-vop ,name :move-argument
 		  (,sc descriptor-reg) (,sc)))))
   (frob move-complex-single-float-argument
-	complex-single-reg complex-single-stack nil)
+	complex-single-reg complex-single-stack :single)
   (frob move-complex-double-float-argument
-	complex-double-reg complex-double-stack t))
+	complex-double-reg complex-double-stack :double))
 
 (define-move-vop move-argument :move-argument
   (single-reg double-reg
@@ -927,7 +938,7 @@
        (inst fxch x)
        (inst fucom y)
        (inst fxch x)))
-     (inst fnstsw)			; status word to %ea
+     (inst fnstsw)			; status word to ax
      (inst and ah-tn #x45)		; C3 C2 C0
      (inst cmp ah-tn #x40)
      (inst jmp (if not-p :ne :e) target)))
@@ -955,8 +966,6 @@
   (:conditional)
   (:info target not-p)
   (:policy :fast-safe)
-  (:vop-var vop)
-  (:save-p :compute-only)
   (:note "inline float comparison")
   (:ignore temp)
   (:generator 3
@@ -971,7 +980,7 @@
 	 (if (sc-is x single-stack)
 	     (inst fcom (ea-for-sf-stack x))
 	   (inst fcom (ea-for-sf-desc x)))))
-      (inst fnstsw)			; status word to %ea
+      (inst fnstsw)			; status word to ax
       (inst and ah-tn #x45))
 
      ;; General case when y is not in ST0.
@@ -993,7 +1002,7 @@
 	 (if (sc-is y single-stack)
 	     (inst fcom (ea-for-sf-stack y))
 	   (inst fcom (ea-for-sf-desc y)))))
-      (inst fnstsw)			; status word to %ea
+      (inst fnstsw)			; status word to ax
       (inst and ah-tn #x45)		; C3 C2 C0
       (inst cmp ah-tn #x01)))
     (inst jmp (if not-p :ne :e) target)))
@@ -1008,8 +1017,6 @@
   (:conditional)
   (:info target not-p)
   (:policy :fast-safe)
-  (:vop-var vop)
-  (:save-p :compute-only)
   (:note "inline float comparison")
   (:ignore temp)
   (:generator 3
@@ -1024,7 +1031,7 @@
 	 (if (sc-is x double-stack)
 	     (inst fcomd (ea-for-df-stack x))
 	   (inst fcomd (ea-for-df-desc x)))))
-      (inst fnstsw)			; status word to %ea
+      (inst fnstsw)			; status word to ax
       (inst and ah-tn #x45))
 
      ;; General case when y is not in ST0.
@@ -1046,12 +1053,11 @@
 	 (if (sc-is y double-stack)
 	     (inst fcomd (ea-for-df-stack y))
 	   (inst fcomd (ea-for-df-desc y)))))
-      (inst fnstsw)			; status word to %ea
+      (inst fnstsw)			; status word to ax
       (inst and ah-tn #x45)		; C3 C2 C0
       (inst cmp ah-tn #x01)))
     (inst jmp (if not-p :ne :e) target)))
 
-
 (define-vop (>single-float)
   (:translate >)
   (:args (x :scs (single-reg single-stack descriptor-reg))
@@ -1062,8 +1068,6 @@
   (:conditional)
   (:info target not-p)
   (:policy :fast-safe)
-  (:vop-var vop)
-  (:save-p :compute-only)
   (:note "inline float comparison")
   (:ignore temp)
   (:generator 3
@@ -1078,7 +1082,7 @@
 	 (if (sc-is x single-stack)
 	     (inst fcom (ea-for-sf-stack x))
 	   (inst fcom (ea-for-sf-desc x)))))
-      (inst fnstsw)			; status word to %ea
+      (inst fnstsw)			; status word to ax
       (inst and ah-tn #x45)
       (inst cmp ah-tn #x01))
 
@@ -1101,7 +1105,7 @@
 	 (if (sc-is y single-stack)
 	     (inst fcom (ea-for-sf-stack y))
 	   (inst fcom (ea-for-sf-desc y)))))
-      (inst fnstsw)			; status word to %ea
+      (inst fnstsw)			; status word to ax
       (inst and ah-tn #x45)))
     (inst jmp (if not-p :ne :e) target)))
 
@@ -1115,8 +1119,6 @@
   (:conditional)
   (:info target not-p)
   (:policy :fast-safe)
-  (:vop-var vop)
-  (:save-p :compute-only)
   (:note "inline float comparison")
   (:ignore temp)
   (:generator 3
@@ -1131,7 +1133,7 @@
 	 (if (sc-is x double-stack)
 	     (inst fcomd (ea-for-df-stack x))
 	   (inst fcomd (ea-for-df-desc x)))))
-      (inst fnstsw)			; status word to %ea
+      (inst fnstsw)			; status word to ax
       (inst and ah-tn #x45)
       (inst cmp ah-tn #x01))
 
@@ -1154,7 +1156,7 @@
 	 (if (sc-is y double-stack)
 	     (inst fcomd (ea-for-df-stack y))
 	   (inst fcomd (ea-for-df-desc y)))))
-      (inst fnstsw)			; status word to %ea
+      (inst fnstsw)			; status word to ax
       (inst and ah-tn #x45)))
     (inst jmp (if not-p :ne :e) target)))
 
@@ -1182,7 +1184,7 @@
        (inst fxch x)
        (inst ftst)
        (inst fxch x)))
-     (inst fnstsw)			; status word to %ea
+     (inst fnstsw)			; status word to ax
      (inst and ah-tn #x45)		; C3 C2 C0
      (unless (zerop code)
         (inst cmp ah-tn code))
@@ -1464,7 +1466,8 @@
 			    :disp (- (* (1+ offset) word-bytes))))))))
 
 (define-vop (single-float-bits)
-  (:args (float :scs (single-reg descriptor-reg)))
+  (:args (float :scs (single-reg descriptor-reg)
+		:load-if (not (sc-is float single-stack))))
   (:results (bits :scs (signed-reg)))
   (:temporary (:sc signed-stack :from :argument :to :result) stack-temp)
   (:arg-types single-float)
@@ -1491,9 +1494,9 @@
 	  (with-tn@fp-top(float)
 	    (inst fst bits))))))))
 
-;; must test
 (define-vop (double-float-high-bits)
-  (:args (float :scs (double-reg descriptor-reg)))
+  (:args (float :scs (double-reg descriptor-reg)
+		:load-if (not (sc-is float double-stack))))
   (:results (hi-bits :scs (signed-reg)))
   (:temporary (:sc double-stack) temp)
   (:arg-types double-float)
@@ -1502,31 +1505,23 @@
   (:policy :fast-safe)
   (:vop-var vop)
   (:generator 5
-    (sc-case hi-bits
-      (signed-reg
-       (sc-case float
-	 (double-reg
-	  (with-tn@fp-top(float)
-	    (let ((where (make-ea :dword :base ebp-tn
-				  :disp (- (* (+ 2 (tn-offset temp))
-					      word-bytes)))))
-	      (inst fstd where)))
-	  (loadw hi-bits ebp-tn (- (1+ (tn-offset temp)))))
-	 (double-stack
-	  (loadw hi-bits ebp-tn (- (1+ (tn-offset float)))))
-	 (descriptor-reg
-	  (loadw hi-bits float (1+ vm:double-float-value-slot)
-		 vm:other-pointer-type))))
-      #+nil ;; should not happen
-      (signed-stack
-       (sc-case float
-	 (double-reg
-	  (inst stf float (current-nfp-tn vop)
-		(* (tn-offset hi-bits) vm:word-bytes))))))))
+     (sc-case float
+       (double-reg
+	(with-tn@fp-top(float)
+	  (let ((where (make-ea :dword :base ebp-tn
+				:disp (- (* (+ 2 (tn-offset temp))
+					    word-bytes)))))
+	    (inst fstd where)))
+	(loadw hi-bits ebp-tn (- (1+ (tn-offset temp)))))
+       (double-stack
+	(loadw hi-bits ebp-tn (- (1+ (tn-offset float)))))
+       (descriptor-reg
+	(loadw hi-bits float (1+ vm:double-float-value-slot)
+	       vm:other-pointer-type)))))
 
-;;needs testing
 (define-vop (double-float-low-bits)
-  (:args (float :scs (double-reg descriptor-reg)))
+  (:args (float :scs (double-reg descriptor-reg)
+		:load-if (not (sc-is float double-stack))))
   (:results (lo-bits :scs (unsigned-reg)))
   (:temporary (:sc double-stack) temp)
   (:arg-types double-float)
@@ -1535,27 +1530,19 @@
   (:policy :fast-safe)
   (:vop-var vop)
   (:generator 5
-    (sc-case lo-bits
-      (unsigned-reg
-       (sc-case float
-	 (double-reg
-	  (with-tn@fp-top(float)
-	    (let ((where (make-ea :dword :base ebp-tn
-				  :disp (- (* (+ 2 (tn-offset temp))
-					      word-bytes)))))
-	      (inst fstd where)))
-	  (loadw lo-bits ebp-tn (- (+ 2 (tn-offset temp)))))
-	 (double-stack
-	  (loadw lo-bits ebp-tn (- (+ 2 (tn-offset float)))))
-	 (descriptor-reg
-	  (loadw lo-bits float  vm:double-float-value-slot
-		 vm:other-pointer-type))))
-      #+nil ;; should not happen
-      (unsigned-stack
-       (sc-case float
-	 (double-reg
-	  (inst stf-odd float (current-nfp-tn vop)
-		(* (tn-offset lo-bits) vm:word-bytes))))))))
+     (sc-case float
+       (double-reg
+	(with-tn@fp-top(float)
+	  (let ((where (make-ea :dword :base ebp-tn
+				:disp (- (* (+ 2 (tn-offset temp))
+					    word-bytes)))))
+	    (inst fstd where)))
+	(loadw lo-bits ebp-tn (- (+ 2 (tn-offset temp)))))
+       (double-stack
+	(loadw lo-bits ebp-tn (- (+ 2 (tn-offset float)))))
+       (descriptor-reg
+	(loadw lo-bits float vm:double-float-value-slot
+	       vm:other-pointer-type)))))
 
 
 ;;;; Float mode hackery:
@@ -1721,7 +1708,7 @@
 			  (unless (location= x y)
 				  (inst fst x))) ; maybe save it
 		  (inst ,op)
-		  (inst fnstsw)			 ; status word to %ea
+		  (inst fnstsw)			 ; status word to ax
 		  (inst and ah-tn #x04)		 ; C2
 		  (inst jmp :z DONE)
 		  ;; Else x was out of range so reduce it; ST0 is unchanged.
@@ -1731,7 +1718,7 @@
 		  (inst fxch fr1)
 		  LOOP
 		  (inst fprem1)
-		  (inst fnstsw)		; status word to %ea
+		  (inst fnstsw)		; status word to ax
 		  (inst and ah-tn #x04)	; C2
 		  (inst jmp :nz LOOP)
 		  (inst ,op)
@@ -1773,7 +1760,7 @@
 				   :sc (sc-or-lose 'double-reg *backend*)
 				   :offset (- (tn-offset x) 2)))))
     (inst fptan)
-    (inst fnstsw)			 ; status word to %ea
+    (inst fnstsw)			 ; status word to ax
     (inst and ah-tn #x04)		 ; C2
     (inst jmp :z DONE)
     ;; Else x was out of range so reduce it; ST0 is unchanged.
@@ -1782,7 +1769,7 @@
     (inst fxch fr1)
     LOOP
     (inst fprem1)
-    (inst fnstsw)			 ; status word to %ea
+    (inst fnstsw)			 ; status word to ax
     (inst and ah-tn #x04)		 ; C2
     (inst jmp :nz LOOP)
     (inst fstp fr1)
@@ -1823,7 +1810,7 @@
 			  (unless (location= x y)
 				  (inst fst x))) ; maybe save it
 		  (inst ,op)
-		  (inst fnstsw)			 ; status word to %ea
+		  (inst fnstsw)			 ; status word to ax
 		  (inst and ah-tn #x04)		 ; C2
 		  (inst jmp :z DONE)
 		  ;; Else x was out of range so reduce it; ST0 is unchanged.
@@ -1867,7 +1854,7 @@
 				   :sc (sc-or-lose 'double-reg *backend*)
 				   :offset (- (tn-offset x) 2)))))
     (inst fptan)
-    (inst fnstsw)			 ; status word to %ea
+    (inst fnstsw)			 ; status word to ax
     (inst and ah-tn #x04)		 ; C2
     (inst jmp :z DONE)
     ;; Else x was out of range so reduce it; ST0 is unchanged.
@@ -2033,7 +2020,7 @@
 	 (inst fldln2)
 	 (if (sc-is x double-stack)
 	     (inst fldd (ea-for-df-stack x))
-	   (inst fldd (ea-for-df-desc x)))
+	     (inst fldd (ea-for-df-desc x)))
 	 (inst fyl2x)))
      (inst fld fr0)
      (case (tn-offset y)
@@ -2084,7 +2071,7 @@
 	 (inst fldlg2)
 	 (if (sc-is x double-stack)
 	     (inst fldd (ea-for-df-stack x))
-	   (inst fldd (ea-for-df-desc x)))
+	     (inst fldd (ea-for-df-desc x)))
 	 (inst fyl2x)))
      (inst fld fr0)
      (case (tn-offset y)
@@ -2226,25 +2213,25 @@
      (sc-case x
        (double-reg
 	(case (tn-offset x)
-	 (0
-	  (inst fstp fr1)
-	  (sc-case y
-	    (signed-reg
-	     (inst mov temp y)
-	     (inst fild temp))
-	    (signed-stack
-	     (inst fild y)))
-	  (inst fxch fr1))
-	 (1
-	  (inst fstp fr0)
-	  (sc-case y
-	    (signed-reg
-	     (inst mov temp y)
-	     (inst fild temp))
-	    (signed-stack
-	     (inst fild y)))
-	  (inst fxch fr1))
-	 (t
+	  (0
+	   (inst fstp fr1)
+	   (sc-case y
+	     (signed-reg
+	      (inst mov temp y)
+	      (inst fild temp))
+	     (signed-stack
+	      (inst fild y)))
+	   (inst fxch fr1))
+	  (1
+	   (inst fstp fr0)
+	   (sc-case y
+	     (signed-reg
+	      (inst mov temp y)
+	      (inst fild temp))
+	     (signed-stack
+	      (inst fild y)))
+	   (inst fxch fr1))
+	  (t
 	   (inst fstp fr0)
 	   (inst fstp fr0)
 	   (sc-case y
@@ -2267,10 +2254,10 @@
 	   (inst fild y)))
 	(if (sc-is x double-stack)
 	    (inst fldd (ea-for-df-stack x))
-	  (inst fldd (ea-for-df-desc x)))))
+	    (inst fldd (ea-for-df-desc x)))))
      (inst fscale)
      (unless (zerop (tn-offset r))
-	     (inst fstd r))))
+       (inst fstd r))))
 
 (define-vop (fscale)
   (:translate %scalb)
@@ -2376,10 +2363,63 @@
      (unless (zerop (tn-offset r))
 	     (inst fstd r))))
 
-;;; Seems to work fine on a Pentium, but the range of the x argument
-;;; is limited on a 386/486.
-(define-vop (flog1p-limited)
-  (:translate %log1p-limited)
+(define-vop (flog1p)
+  (:translate %log1p)
+  (:args (x :scs (double-reg) :to :result))
+  (:temporary (:sc double-reg :offset fr0-offset
+		   :from :argument :to :result) fr0)
+  (:temporary (:sc double-reg :offset fr1-offset
+		   :from :argument :to :result) fr1)
+  (:temporary (:sc word-reg :offset eax-offset :from :eval) temp)
+  (:results (y :scs (double-reg)))
+  (:arg-types double-float)
+  (:result-types double-float)
+  (:policy :fast-safe)
+  (:guard (not (backend-featurep :pentium)))
+  (:note "inline log1p function")
+  (:ignore temp)
+  (:generator 5
+     ;; x is in a FP reg, not fr0, fr1.
+     (inst fstp fr0)
+     (inst fstp fr0)
+     (inst fldd (make-random-tn :kind :normal
+				:sc (sc-or-lose 'double-reg *backend*)
+				:offset (- (tn-offset x) 2)))
+     ;; Check the range
+     (inst push #x3e947ae1)	; Constant 0.29
+     (inst fabs)
+     (inst fld (make-ea :dword :base esp-tn))
+     (inst fcompp)
+     (inst add esp-tn 4)
+     (inst fnstsw)			; status word to ax
+     (inst and ah-tn #x45)
+     (inst jmp :z WITHIN-RANGE)
+     ;; Out of range for fyl2xp1.
+     (inst fld1)
+     (inst faddd (make-random-tn :kind :normal
+				 :sc (sc-or-lose 'double-reg *backend*)
+				 :offset (- (tn-offset x) 1)))
+     (inst fldln2)
+     (inst fxch fr1)
+     (inst fyl2x)
+     (inst jmp DONE)
+
+     WITHIN-RANGE
+     (inst fldln2)
+     (inst fldd (make-random-tn :kind :normal
+				:sc (sc-or-lose 'double-reg *backend*)
+				:offset (- (tn-offset x) 1)))
+     (inst fyl2xp1)
+     DONE
+     (inst fld fr0)
+     (case (tn-offset y)
+       ((0 1))
+       (t (inst fstd y)))))
+
+;;; The Pentium has a less restricted implementation of the fyl2xp1
+;;; instruction and a range check can be avoided.
+(define-vop (flog1p-pentium)
+  (:translate %log1p)
   (:args (x :scs (double-reg double-stack descriptor-reg) :target fr0))
   (:temporary (:sc double-reg :offset fr0-offset
 		   :from :argument :to :result) fr0)
@@ -2389,6 +2429,7 @@
   (:arg-types double-float)
   (:result-types double-float)
   (:policy :fast-safe)
+  (:guard (backend-featurep :pentium))
   (:note "inline log1p with limited x range function")
   (:vop-var vop)
   (:save-p :compute-only)
@@ -2414,16 +2455,15 @@
 	     (inst fldln2)
 	     (inst fldd (make-random-tn :kind :normal
 					:sc (sc-or-lose 'double-reg *backend*)
-					:offset (- (tn-offset x) 2)))))
-	 (inst fyl2xp1))
+					:offset (- (tn-offset x) 2))))))
 	((double-stack descriptor-reg)
 	 (inst fstp fr0)
 	 (inst fstp fr0)
 	 (inst fldln2)
 	 (if (sc-is x double-stack)
 	     (inst fldd (ea-for-df-stack x))
-	   (inst fldd (ea-for-df-desc x)))
-	 (inst fyl2xp1)))
+	   (inst fldd (ea-for-df-desc x)))))
+     (inst fyl2xp1)
      (inst fld fr0)
      (case (tn-offset y)
        ((0 1))