diff --git a/code/float.lisp b/code/float.lisp
index 20476280a630b8095be44bef23cb5039d9c2e856..facfb13abf5581c9528f182e4de43a16f2dfee3c 100644
--- a/code/float.lisp
+++ b/code/float.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/float.lisp,v 1.6 1990/12/06 18:47:44 ram Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/float.lisp,v 1.7 1990/12/12 00:01:16 ram Exp $
 ;;;
 ;;;    This file contains the definitions of float specific number support
 ;;; (other than irrational stuff, which is in irrat.)  There is code in here
@@ -16,6 +16,7 @@
 ;;; Author: Rob MacLachlan
 ;;; 
 (in-package "KERNEL")
+(export '(%unary-truncate %unary-round))
 
 (in-package "LISP")
 (export '(least-positive-normalized-short-float
@@ -639,6 +640,69 @@
   (frob %double-float double-float))
 
 
+#|
+These might be useful if we ever have a machine w/o float/integer conversion
+hardware.  For now, we'll use special ops that uninterruptibly frob the
+rounding modes & do ieee round-to-integer.
+
+;;; %UNARY-TRUNCATE-SINGLE-FLOAT/FIXNUM  --  Interface
+;;;
+;;;    The compiler compiles a call to this when we are doing %UNARY-TRUNCATE
+;;; and the result is known to be a fixnum.  We can avoid some generic
+;;; arithmetic in this case.
+;;;
+(defun %unary-truncate-single-float/fixnum (x)
+  (declare (single-float x) (values fixnum))
+  (locally (declare (optimize (speed 3) (safety 0)))
+    (let* ((bits (single-float-bits x))
+	   (exp (ldb vm:single-float-exponent-byte bits))
+	   (frac (logior (ldb vm:single-float-significand-byte bits)
+			 vm:single-float-hidden-bit))
+	   (shift (- exp vm:single-float-digits vm:single-float-bias)))
+      (when (> exp vm:single-float-normal-exponent-max)
+	(error 'floating-point-invalid :operator 'truncate
+	       :operands (list x)))
+      (if (<= shift (- vm:single-float-digits))
+	  0
+	  (let ((res (ash frac shift)))
+	    (declare (type (unsigned-byte 31) res)) 
+	    (if (minusp bits)
+		(- res)
+		res))))))
+
+
+;;; %UNARY-TRUNCATE-DOUBLE-FLOAT/FIXNUM  --  Interface
+;;;
+;;;    Double-float version of this operation (see above single op).
+;;;
+(defun %unary-truncate-double-float/fixnum (x)
+  (declare (double-float x) (values fixnum))
+  (locally (declare (optimize (speed 3) (safety 0)))
+    (let* ((hi-bits (double-float-high-bits x))
+	   (exp (ldb vm:double-float-exponent-byte hi-bits))
+	   (frac (logior (ldb vm:double-float-significand-byte hi-bits)
+			 vm:double-float-hidden-bit))
+	   (shift (- exp (- vm:double-float-digits vm:word-bits)
+		     vm:double-float-bias)))
+      (when (> exp vm:double-float-normal-exponent-max)
+	(error 'floating-point-invalid :operator 'truncate
+	       :operands (list x)))
+      (if (<= shift (- vm:word-bits vm:double-float-digits))
+	  0
+	  (let* ((res-hi (ash frac shift))
+		 (res (if (plusp shift)
+			  (logior res-hi
+				  (the fixnum
+				       (ash (double-float-low-bits x)
+					    (- shift vm:word-bits))))
+			  res-hi)))
+	    (declare (type (unsigned-byte 31) res-hi res))
+	    (if (minusp hi-bits)
+		(- res)
+		res))))))
+|#
+
+  
 ;;; %UNARY-TRUNCATE  --  Interface
 ;;;
 ;;;    This function is called when we are doing a truncate without any funky
@@ -646,14 +710,19 @@
 ;;; *not* return the second value of truncate, so it must be computed by the
 ;;; caller if needed.
 ;;;
+;;;    In the float case, we pick off small arguments so that compiler can use
+;;; special-case operations.  We use an exclusive test, since (due to round-off
+;;; error), (float most-positive-fixnum) may be greater than
+;;; most-positive-fixnum.
+;;;
 (defun %unary-truncate (number)
   (number-dispatch ((number real))
     ((integer) number)
-    ((ratio) (truncate (numerator number) (denominator number)))
+    ((ratio) (values (truncate (numerator number) (denominator number))))
     (((foreach single-float double-float))
-     (if (<= (float most-negative-fixnum number)
-	     number
-	     (float most-positive-fixnum number))
+     (if (< (float most-negative-fixnum number)
+	    number
+	    (float most-positive-fixnum number))
 	 (truly-the fixnum (%unary-truncate number))
 	 (multiple-value-bind (bits exp)
 			      (integer-decode-float number)
@@ -663,6 +732,39 @@
 		 res)))))))
 
 
+;;; %UNARY-ROUND  --  Interface
+;;;
+;;;    Similar to %UNARY-TRUNCATE, but rounds to the nearest integer.  If we
+;;; can't use the round primitive, then we do our own round-to-nearest on the
+;;; result of i-d-f.  [Note that this rounding will really only happen with
+;;; double floats, since the whole single-float fraction will fit in a fixnum,
+;;; so all single-floats larger than most-positive-fixnum can be precisely
+;;; represented by an integer.]
+;;;
+(defun %unary-round (number)
+  (number-dispatch ((number real))
+    ((integer) number)
+    ((ratio) (values (round (numerator number) (denominator number))))
+    (((foreach single-float double-float))
+     (if (< (float most-negative-fixnum number)
+	    number
+	    (float most-positive-fixnum number))
+	 (truly-the fixnum (%unary-round number))
+	 (multiple-value-bind (bits exp)
+			      (integer-decode-float number)
+	   (let* ((shifted (ash bits exp))
+		  (rounded (if (and (minusp exp)
+				    (oddp shifted)
+				    (eql (logand bits
+						 (lognot (ash -1 (- exp))))
+					 (ash 1 (- -1 exp))))
+			       (1+ shifted)
+			       shifted)))
+	     (if (minusp number)
+		 (- rounded)
+		 rounded)))))))
+
+
 (defun rational (x)
   "RATIONAL produces a rational number for any real numeric argument.  This is
   more efficient than RATIONALIZE, but it assumes that floating-point is