From 457085b8d857972b14453ef2965ba236f99bcd7f Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Fri, 7 May 1993 12:10:52 +0000 Subject: [PATCH] Added FLOAT-RATIO for precise ratio floating (as need by the float reader.) --- code/float.lisp | 73 +++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 67 insertions(+), 6 deletions(-) diff --git a/code/float.lisp b/code/float.lisp index 69fd92985..4b53e2e2a 100644 --- a/code/float.lisp +++ b/code/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/code/float.lisp,v 1.10 1992/12/10 01:28:22 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/float.lisp,v 1.11 1993/05/07 12:10:52 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -653,15 +653,76 @@ ((bignum) (bignum-to-float x ',type)) ((ratio) - (let ((num (numerator x)) - (den (denominator x))) - (if (and (fixnump num) (fixnump den)) - (/ (coerce num ',type) (coerce den ',type)) - (float-bignum-ratio x ',type)))))))) + (float-ratio x ',type)))))) (frob %single-float single-float) (frob %double-float double-float)) +;;; FLOAT-RATIO -- Internal +;;; +;;; Convert a ratio to a float. We avoid any rounding error by doing an +;;; integer division. Accuracy is important to preserve read/print +;;; consistency, since this is ultimately how the reader reads a float. We +;;; scale the numerator by a power of two until the division results in the +;;; desired number of fraction bits, then do round-to-nearest. +;;; +(defun float-ratio (x format) + (let* ((signed-num (numerator x)) + (plusp (plusp signed-num)) + (num (if plusp signed-num (- signed-num))) + (den (denominator x)) + (digits (float-format-digits format)) + (scale 0)) + (declare (fixnum digits scale)) + ;; + ;; Strip any trailing zeros from the denominator and move it into the scale + ;; factor (to minimize the size of the operands.) + (let ((den-twos (1- (integer-length (logxor den (1- den)))))) + (declare (fixnum den-twos)) + (decf scale den-twos) + (setq den (ash den (- den-twos)))) + ;; + ;; Guess how much we need to scale by from the magnitudes of the numerator + ;; and denominator. We want one extra bit for a guard bit. + (let* ((num-len (integer-length num)) + (den-len (integer-length den)) + (delta (- den-len num-len)) + (shift (1+ (the fixnum (+ delta digits)))) + (shifted-num (ash num shift))) + (declare (fixnum delta shift)) + (decf scale delta) + (labels ((float-and-scale (bits) + (let* ((bits (ash bits -1)) + (len (integer-length bits))) + (cond ((> len digits) + (assert (= len (the fixnum (1+ digits)))) + (scale-float (floatit (ash bits -1)) (1+ scale))) + (t + (scale-float (floatit bits) scale))))) + (floatit (bits) + (let ((sign (if plusp 0 1))) + (if (eq format 'single-float) + (single-from-bits sign vm:single-float-bias bits) + (double-from-bits sign vm:double-float-bias bits))))) + (loop + (multiple-value-bind (fraction-and-guard rem) + (truncate shifted-num den) + (let ((extra (- (integer-length fraction-and-guard) digits))) + (declare (fixnum extra)) + (cond ((/= extra 1) + (assert (> extra 1))) + ((oddp fraction-and-guard) + (if (zerop rem) + (float-and-scale + (if (zerop (logand fraction-and-guard 2)) + fraction-and-guard + (1+ fraction-and-guard))) + (return (float-and-scale (1+ fraction-and-guard))))) + (t + (return (float-and-scale fraction-and-guard))))) + (setq shifted-num (ash shifted-num -1)) + (incf scale))))))) + #| 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 -- GitLab