X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Freader.lisp;h=8f885fa97279d74e279b25087a6cf9314b0b0ed9;hb=cee8ef591040db9a79cdd19297867672a9529051;hp=5d85c730bb09c8b51dd7a4f7c782961c78e242f9;hpb=ac93aa515b197d751dad85d70432ebc87fac420a;p=sbcl.git diff --git a/src/code/reader.lisp b/src/code/reader.lisp index 5d85c73..8f885fa 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -1409,6 +1409,24 @@ extended :: syntax." (the index (* num base)))))))) (setq number (+ num (* number base-power))))))) +(defun truncate-exponent (exponent number divisor) + "Truncate exponent if it's too large for a float" + ;; Work with base-2 logarithms to avoid conversions to floats, + ;; and convert to base-10 conservatively at the end. + ;; Use the least positive float, because denormalized exponent + ;; can be larger than normalized. + (let* ((max-exponent + #!-long-float + (+ sb!vm:double-float-digits sb!vm:double-float-bias)) + (number-magnitude (integer-length number)) + (divisor-magnitude (1- (integer-length divisor))) + (magnitude (- number-magnitude divisor-magnitude))) + (if (minusp exponent) + (max exponent (ceiling (- (+ max-exponent magnitude)) + #.(floor (log 10 2)))) + (min exponent (floor (- max-exponent magnitude) + #.(floor (log 10 2))))))) + (defun make-float (stream) ;; Assume that the contents of *read-buffer* are a legal float, with nothing ;; else after it. @@ -1469,6 +1487,7 @@ extended :: syntax." (#\F 'single-float) (#\D 'double-float) (#\L 'long-float))) + (exponent (truncate-exponent exponent number divisor)) (result (make-float-aux (* (expt 10 exponent) number) divisor float-format stream))) (return-from make-float @@ -1481,7 +1500,8 @@ extended :: syntax." (type-error (c) (error 'reader-impossible-number-error :error c :stream stream - :format-control "failed to build float")))) + :format-control "failed to build float from ~a" + :format-arguments (list (read-buffer-to-string)))))) (defun make-ratio (stream) ;; Assume *READ-BUFFER* contains a legal ratio. Build the number from