From: Juho S. <js...@us...> - 2005-02-11 07:33:02
|
Update of /cvsroot/sbcl/sbcl/src/code In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1164/src/code Modified Files: numbers.lisp Log Message: 0.8.19.23: Optimize float/fixnum comparisons, primarily for the benefit of McCLIM. If the fixnum's value is in a range where it's guaranteed to have an exact float representation, coerce it to a float and do a float comparison. Otherwise fall back to the old behaviour of rationalizing the float. Index: numbers.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/numbers.lisp,v retrieving revision 1.43 retrieving revision 1.44 diff -u -d -r1.43 -r1.44 --- numbers.lisp 28 Jan 2005 09:01:28 -0000 1.43 +++ numbers.lisp 11 Feb 2005 07:32:52 -0000 1.44 @@ -819,6 +819,15 @@ (declare (type real number result)) (if (< (car nlist) result) (setq result (car nlist))))) +(defconstant most-positive-exactly-single-float-fixnum + (min #xffffff most-positive-fixnum)) +(defconstant most-negative-exactly-single-float-fixnum + (max #x-ffffff most-negative-fixnum)) +(defconstant most-positive-exactly-double-float-fixnum + (min #x1fffffffffffff most-positive-fixnum)) +(defconstant most-negative-exactly-double-float-fixnum + (max #x-1fffffffffffff most-negative-fixnum)) + (eval-when (:compile-toplevel :execute) ;;; The INFINITE-X-FINITE-Y and INFINITE-Y-FINITE-X args tell us how @@ -838,6 +847,40 @@ #!+long-float ((long-float (foreach single-float double-float)) (,op x (coerce y 'long-float))) + ((fixnum (foreach single-float double-float)) + (if (float-infinity-p y) + ,infinite-y-finite-x + ;; If the fixnum has an exact float representation, do a + ;; float comparison. Otherwise do the slow float -> ratio + ;; conversion. + (multiple-value-bind (lo hi) + (case '(dispatch-type y) + ('single-float + (values most-negative-exactly-single-float-fixnum + most-positive-exactly-single-float-fixnum)) + ('double-float + (values most-negative-exactly-double-float-fixnum + most-positive-exactly-double-float-fixnum))) + (if (<= lo y hi) + (,op (coerce x '(dispatch-type y)) y) + (,op x (rational y)))))) + (((foreach single-float double-float) fixnum) + (if (eql y 0) + (,op x (coerce 0 '(dispatch-type x))) + (if (float-infinity-p x) + ,infinite-x-finite-y + ;; Likewise + (multiple-value-bind (lo hi) + (case '(dispatch-type x) + ('single-float + (values most-negative-exactly-single-float-fixnum + most-positive-exactly-single-float-fixnum)) + ('double-float + (values most-negative-exactly-double-float-fixnum + most-positive-exactly-double-float-fixnum))) + (if (<= lo y hi) + (,op x (coerce y '(dispatch-type x))) + (,op (rational x) y)))))) (((foreach single-float double-float) double-float) (,op (coerce x 'double-float) y)) ((double-float single-float) |