Commit d611150a authored by rtoy's avatar rtoy
Browse files

Implement a fast fround for single and double floats. This is enabled

everywhere except for x87 builds since there is a possible roundoff
issue due to the 80-bit registers for x87.

This is some 2-3 times faster than the existing fround function.

code/float.lisp:
o Implementations of %unary-fround/single-float,
  %unary-fround/double-float, and %unary-fround.  Declare the first
  two as inline too.

compiler/float-tran.lisp:
o Tell compiler about %unary-fround.
o Transform fround to a call to %unary-fround.
o Transform %unary-fround to special versions for single and double
  float arguments.
parent db3bb369
......@@ -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/float.lisp,v 1.43 2008/12/22 23:24:28 rtoy Rel $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/float.lisp,v 1.44 2010/02/05 18:10:58 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -20,6 +20,9 @@
(export '(%unary-truncate %unary-round %unary-ftruncate
%unary-ftruncate/single-float %unary-ftruncate/double-float))
#-x87
(export '(%unary-fround/single-float %unary-fround/double-float))
(in-package "LISP")
(export '(least-positive-normalized-short-float
least-positive-normalized-single-float
......@@ -1412,9 +1415,56 @@ rounding modes & do ieee round-to-integer.
#+double-double
((double-double-float)
(%unary-ftruncate/double-double-float number))))
;; %UNARY-FROUND not implemented for x87. I think there are potential
;; roundoff problems due to the 80-bit FPU registers.
#-x87
(progn
(declaim (inline %unary-fround/single-float %unary-fround/double-float))
;; %UNARY-FROUND/DOUBLE-FLOAT
;;
;; Basically the same as fround, but specialized to handle only
;; double-floats and to return the first value. This is the algorithm
;; given by Anton Ertl in comp.arch.arithmetic, Oct 26, 2002.
(defun %unary-fround/double-float (x)
(declare (double-float x))
(let ((const (scale-float 1d0 53)))
(if (>= x 0)
(+ (- x const) const)
(- (+ x const) const))))
;; %UNARY-FROUND/SINLGE-FLOAT
;;
;; Same as %UNARY-FROUND/DOUBLE-FLOAT, except specialized for single-float.
(defun %unary-fround/single-float (x)
(declare (single-float x))
(let ((const (scale-float 1f0 24)))
(if (>= x 0)
(+ (- x const) const)
(- (+ x const) const))))
;;; %UNARY-FROUND -- Interface
;;;
;;; This function is called when we are doing an fround without any
;;; funky divisor. Note that we do *not* return the second value of
;;; round, so it must be computed by the caller if needed.
;;;
(defun %unary-fround (number)
(number-dispatch ((number real))
((integer)
(float number))
((ratio)
(float (round (numerator number) (denominator number))))
((single-float)
(%unary-fround/single-float number))
((double-float)
(%unary-fround/double-float number))))
) ; not x87
(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
......
......@@ -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.135 2009/11/02 15:05:06 rtoy Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.136 2010/02/05 18:10:59 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -235,6 +235,32 @@
(frob single-float %unary-ftruncate/single-float)
(frob double-float %unary-ftruncate/double-float))
;;; FROUND
#-x87
(progn
(deftransform fround ((x &optional (y 1))
((or single-float double-float)
&optional (or single-float double-float integer)))
'(let ((res (%unary-fround (/ x y))))
(values res (- x (* y res)))))
(defknown %unary-fround (real) float
(movable foldable flushable))
(defknown %unary-fround/single-float (single-float) single-float
(movable foldable flushable))
(defknown %unary-fround/double-float (double-float) double-float
(movable foldable flushable))
(deftransform %unary-fround ((x) (single-float))
'(%unary-fround/single-float x))
(deftransform %unary-fround ((x) (double-float))
'(%unary-fround/double-float x))
); not x87
;;; Random:
;;;
(macrolet ((frob (fun type)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment