Raymond Toy pushed to branch master at cmucl / cmucl

Commits:

4 changed files:

Changes:

  • src/code/reader.lisp
    ... ... @@ -1832,56 +1832,70 @@ the end of the stream."
    1832 1832 
       ;; throw an error immediately.  We don't need to be super accurate
    1833 1833 
       ;; with the limits.  The rest of the code will handle it correctly,
    1834 1834 
       ;; even if we're too small or too large.
    1835 
    -  (unless (zerop number)
    1836 
    -    (flet ((fast-log2 (n)
    1837 
    -             ;;  For an integer, the integer-length is close enough to
    1838 
    -             ;;  the log2 of the number.
    1839 
    -             (integer-length n)))
    1840 
    -      ;; log2(x) = log(number*10^exponent/divisor)
    1841 
    -      ;;         = exponent*log2(10) + log2(number)-log2(divisor)
    1842 
    -      (let ((log2-num (+ (* exponent #.(kernel::log2 10d0))
    1843 
    -                         (fast-log2 number)
    1844 
    -                         (- (fast-log2 divisor)))))
    1845 
    -        (multiple-value-bind (log2-low log2-high)
    1846 
    -            (ecase float-format
    1847 
    -              ((short-float single-float)
    1848 
    -               ;; Single-float exponents range is -149 to 127, but we
    1849 
    -               ;; don't need to be super-accurate since we're
    1850 
    -               ;; multiplying the values by 2.
    1851 
    -               (values (* 2 (- vm:single-float-normal-exponent-min
    1852 
    -                               vm:single-float-bias
    1853 
    -                               vm:single-float-digits))
    1854 
    -                       (* 2 (- vm:single-float-normal-exponent-max
    1855 
    -                               vm:single-float-bias))))
    1856 
    -              ((double-float long-float
    1857 
    -                             #+double-double kernel:double-double-float)
    1858 
    -               (values (* 2 (- vm:double-float-normal-exponent-min
    1859 
    -                               vm:double-float-bias
    1860 
    -                               vm:double-float-digits))
    1861 
    -                       (* 2 (- vm:double-float-normal-exponent-max
    1862 
    -                               vm:double-float-bias)))))
    1863 
    -          ;; Double-float exponent range is -1074 to -1023
    1864 
    -          (unless (< log2-low log2-num log2-high)
    1865 
    -            ;; The number is definitely too large or too small to fit.
    1866 
    -            ;; Signal an error.
    1867 
    -            (%reader-error stream _"Number not representable as a ~S: ~S"
    1868 
    -			   float-format (read-buffer-to-string)))))))
    1869 
    -
    1870 
    -  ;; Otherwise the number might fit, so we carefully compute the result.
    1871 
    -  (handler-case
    1872 
    -      (with-float-traps-masked (:underflow)
    1873 
    -	(let* ((ratio (/ (* (expt 10 exponent) number)
    1874 
    -                         divisor))
    1875 
    -	       (result (coerce ratio float-format)))
    1876 
    -	  (when (and (zerop result) (not (zerop number)))
    1877 
    -	    ;; The number we've read is so small that it gets
    1878 
    -	    ;; converted to 0.0, but is not actually zero.  Signal an
    1879 
    -	    ;; error.  See CLHS 2.3.1.1.
    1880 
    -            (error _"Underflow"))
    1881 
    -          result))
    1882 
    -    (error ()
    1883 
    -	   (%reader-error stream _"Number not representable as a ~S: ~S"
    1884 
    -			  float-format (read-buffer-to-string)))))
    1835 
    +  (flet ((handle-extreme-numbers ()
    1836 
    +           (unless (zerop number)
    1837 
    +             (flet ((fast-log2 (n)
    1838 
    +                      ;;  For an integer, the integer-length is close enough to
    1839 
    +                      ;;  the log2 of the number.
    1840 
    +                      (integer-length n)))
    1841 
    +               ;; log2(x) = log(number*10^exponent/divisor)
    1842 
    +               ;;         = exponent*log2(10) + log2(number)-log2(divisor)
    1843 
    +               (let ((log2-num (+ (* exponent #.(kernel::log2 10d0))
    1844 
    +                                  (fast-log2 number)
    1845 
    +                                  (- (fast-log2 divisor)))))
    1846 
    +                 (multiple-value-bind (log2-low log2-high)
    1847 
    +                     (ecase float-format
    1848 
    +                       ((short-float single-float)
    1849 
    +                        ;; Single-float exponents range is -149 to 127, but we
    1850 
    +                        ;; don't need to be super-accurate since we're
    1851 
    +                        ;; multiplying the values by 2.
    1852 
    +                        (values (* 2 (- vm:single-float-normal-exponent-min
    1853 
    +                                        vm:single-float-bias
    1854 
    +                                        vm:single-float-digits))
    1855 
    +                                (* 2 (- vm:single-float-normal-exponent-max
    1856 
    +                                        vm:single-float-bias))))
    1857 
    +                       ((double-float long-float
    1858 
    +                                      #+double-double kernel:double-double-float)
    1859 
    +                        ;; Double-float exponent range is -1074 to -1023
    1860 
    +                        (values (* 2 (- vm:double-float-normal-exponent-min
    1861 
    +                                        vm:double-float-bias
    1862 
    +                                        vm:double-float-digits))
    1863 
    +                                (* 2 (- vm:double-float-normal-exponent-max
    1864 
    +                                        vm:double-float-bias)))))
    1865 
    +                   (when (<= log2-num log2-low)
    1866 
    +                     ;; Number is definitely too small; signal an underflow.
    1867 
    +                     (error 'floating-point-underflow))
    1868 
    +                   (when (>= log2-num log2-high)
    1869 
    +                     ;; Number is definitely too large; signal an error
    1870 
    +                     (error "Overflow"))))))))
    1871 
    +
    1872 
    +    ;; Otherwise the number might fit, so we carefully compute the result.
    1873 
    +    (handler-case
    1874 
    +        (with-float-traps-masked (:underflow)
    1875 
    +          (handle-extreme-numbers)
    1876 
    +          (let* ((ratio (/ (* (expt 10 exponent) number)
    1877 
    +                           divisor))
    1878 
    +	         (result (coerce ratio float-format)))
    1879 
    +	    (when (and (zerop result) (not (zerop number)))
    1880 
    +	      ;; The number we've read is so small that it gets
    1881 
    +	      ;; converted to 0.0, but is not actually zero.  Signal an
    1882 
    +	      ;; error.  See CLHS 2.3.1.1.
    1883 
    +              (error 'floating-point-underflow))
    1884 
    +            result))
    1885 
    +      (floating-point-underflow ()
    1886 
    +        ;; Resignal a reader error, but allow the user to continue with
    1887 
    +        ;; 0.
    1888 
    +        (let ((zero (coerce 0 float-format)))
    1889 
    +          (restart-case
    1890 
    +              (%reader-error stream _"Floating point underflow when reading ~S: ~S"
    1891 
    +                             float-format (read-buffer-to-string))
    1892 
    +            (continue ()
    1893 
    +              :report (lambda (stream)
    1894 
    +                        (format stream "Return ~A" zero))
    1895 
    +              zero))))
    1896 
    +      (error ()
    1897 
    +	(%reader-error stream _"Number not representable as a ~S: ~S"
    1898 
    +		       float-format (read-buffer-to-string))))))
    1885 1899
    1886 1900
    1887 1901 
     (defun make-ratio (stream)

  • src/general-info/release-21f.md
    ... ... @@ -56,6 +56,7 @@ public domain.
    56 56 
         * ~~#271~~ Update ASDF to 3.3.7
    57 57 
         * ~~#272~~ Move scavenge code for static vectors to its own function
    58 58 
         * ~~#274~~ 1d99999999 hangs
    59 
    +    * ~~#275~~ FP underflow in reader allows restarting with 0
    59 60 
         * ~~#276~~ Implement xoroshiro128** generator for x86
    60 61 
         * ~~#277~~ `float-ratio-float` returns 0 for numbers close to
    61 62 
           least-positive-float

  • src/i18n/locale/cmucl.pot
    ... ... @@ -8750,11 +8750,11 @@ msgid "Internal error in floating point reader."
    8750 8750 
     msgstr ""
    8751 8751
    8752 8752 
     #: src/code/reader.lisp
    8753 
    -msgid "Number not representable as a ~S: ~S"
    8753 
    +msgid "Floating point underflow when reading ~S: ~S"
    8754 8754 
     msgstr ""
    8755 8755
    8756 8756 
     #: src/code/reader.lisp
    8757 
    -msgid "Underflow"
    8757 
    +msgid "Number not representable as a ~S: ~S"
    8758 8758 
     msgstr ""
    8759 8759
    8760 8760 
     #: src/code/reader.lisp

  • tests/float.lisp
    ... ... @@ -247,3 +247,44 @@
    247 247 
         (assert-equal 0.9999999999999999d0
    248 248 
                       (rounding-test 3d0))))
    249 249
    250 
    +(define-test reader.underflow-enabled
    251 
    +    (:tag :issues)
    252 
    +  ;; Test with FP underflow enabled, we can still read denormals
    253 
    +  ;; without problem.  For this test we only care that we get a
    254 
    +  ;; number, not the actual value.
    255 
    +  (dolist (n (list least-positive-single-float
    256 
    +                   least-positive-normalized-single-float
    257 
    +                   (/ (+ least-positive-single-float
    258 
    +                         least-positive-normalized-single-float)
    259 
    +                      2)
    260 
    +                   least-positive-double-float
    261 
    +                   least-positive-normalized-double-float
    262 
    +                   (/ (+ least-positive-double-float
    263 
    +                         least-positive-normalized-double-float)
    264 
    +                      2)
    265 
    +                   ))
    266 
    +    (assert-true (floatp
    267 
    +                  (ext:with-float-traps-enabled (:underflow)
    268 
    +                    (read-from-string (format nil "~A" n)))))))
    269 
    +
    270 
    +(define-test reader-restarts.underflow
    271 
    +    (:tag :issues)
    272 
    +  ;; Test that we get a restart when reading floating-point numbers
    273 
    +  ;; that are too small to fit in a float.  Invoke the restart to
    274 
    +  ;; return 0.  All the numbers must be less than half the
    275 
    +  ;; leasst-positive float.
    276 
    +  (dolist (item '(("1e-46" 0f0)
    277 
    +                  ("1e-999" 0f0)
    278 
    +                  ("1d-324" 0d0)
    279 
    +                  ("1d-999" 0d0)))
    280 
    +    (destructuring-bind (string expected-value)
    281 
    +        item
    282 
    +      (assert-equal expected-value
    283 
    +                    (values (handler-bind
    284 
    +                                ((reader-error
    285 
    +                                   (lambda (c)
    286 
    +                                     (declare (ignore c))
    287 
    +                                     (invoke-restart 'lisp::continue))))
    288 
    +                              (read-from-string string)))))))
    289 
    +
    290 
    +

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.common-lisp.net. Manage all notifications · Help