From: Christophe Rhodes Date: Tue, 11 May 2004 18:29:50 +0000 (+0000) Subject: 0.8.10.19: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=7c1298a73f97b8c71474d8aa4a7c8f863fe0718d;p=sbcl.git 0.8.10.19: Fix floating point read/print consistency, with a slightly tidied up version of Burger and Dybvig from the one CSR posted to sbcl-devel ca. end 2004-04. ... no more recursion, yay! ... still two versions of float printing algorithms ... test case ... fix the reader too. (The original workaround was probably a CMUCLism from having :underflow traps enabled; since SBCL has never been distributed with underflow traps, we can remove the workaround). Log all remaining undisputed bugs from Bruno Haible. --- diff --git a/BUGS b/BUGS index e2c7ca7..2304eb1 100644 --- a/BUGS +++ b/BUGS @@ -382,6 +382,20 @@ WORKAROUND: Raymond Toy comments that this is tricky on the X86 since its FPU uses 80-bit precision internally. + Bruno Haible comments: + The values are those that are expected for an IEEE double-float + arithmetic. The problem appears to be that the rounding is not + IEEE on x86 compliant: namely, values are first rounded to 64 + bits mantissa precision, then only to 53 bits mantissa + precision. This gives different results than rounding to 53 bits + mantissa precision in a single step. + + The quick "fix", to permanently change the FPU control word from + 0x037f to 0x027f, will give problems with the fdlibm code that is + used for computing transcendental functions like sinh() etc. + so maybe we need to change the FPU control word to that for Lisp + code, and adjust it to the safe 0x037f for calls to C? + 124: As of version 0.pre7.14, SBCL's implementation of MACROLET makes the entire lexical environment at the point of MACROLET available @@ -1310,38 +1324,6 @@ WORKAROUND: around the same time regarding a call to LIST on sparc with 1000 arguments) and other implementation limit constants. -310: "Floating point printing inaccuracy" - (reported by Bruno Haible sbcl-devel "print-read consistency for - floating point numbers" 2004-04-19) - (let ((x (/ -9.349640046247849d-21 -9.381494249123696d-11))) - (let ((y (read-from-string (write-to-string x :readably t)))) - (eql x y))) - should return T but, as of sbcl-0.8.9.51, returns NIL. - - That this is a bug in the printer is demonstrated by - (setq x1 (float -5496527/100000000000000000)) - (setq x2 (float -54965272/1000000000000000000)) - (integer-decode-float x1) => 15842660 -58 -1 - (integer-decode-float x2) => 15842661 -58 -1 - (prin1-to-string x1) => "-5.496527e-11" - (prin1-to-string x2) => "-5.496527e-11" ; should be different! - - Note also the following comment from src/code/print.lisp: - ;;; NOTE: When a number is to be printed in exponential format, it is - ;;; scaled in floating point. Since precision may be lost in this - ;;; process, the guaranteed accuracy properties of FLONUM-TO-STRING - ;;; are lost. The difficulty is that FLONUM-TO-STRING performs - ;;; extensive computations with integers of similar magnitude to that - ;;; of the number being printed. For large exponents, the bignums - ;;; really get out of hand. If bignum arithmetic becomes reasonably - ;;; fast and the exponent range is not too large, then it might become - ;;; attractive to handle exponential notation with the same accuracy - ;;; as non-exponential notation, using the method described in the - ;;; Steele and White paper. - - See also CSR sbcl-devel with an implementation of Berger and - Dybvig's algorithm for printing and a fix for reading. - 311: "Tokeniser not thread-safe" (see also Robert Marlow sbcl-help "Multi threaded read chucking a spak" 2004-04-19) @@ -1363,3 +1345,121 @@ WORKAROUND: 313: "source-transforms are Lisp-1" (fixed in 0.8.10.2) + +314: "LOOP :INITIALLY clauses and scope of initializers" + reported by Bruno Haible sbcl-devel "various SBCL bugs" from CLISP + test suite, originally by Thomas F. Burdick. + ;; + ;; According to the HyperSpec 6.1.2.1.4, in for-as-equals-then, var is + ;; initialized to the result of evaluating form1. 6.1.7.2 says that + ;; initially clauses are evaluated in the loop prologue, which precedes all + ;; loop code except for the initial settings provided by with, for, or as. + (loop :for x = 0 :then (1+ x) + :for y = (1+ x) :then (ash y 1) + :for z :across #(1 3 9 27 81 243) + :for w = (+ x y z) + :initially (assert (zerop x)) :initially (assert (= 2 w)) + :until (>= w 100) :collect w) + Expected: (2 6 15 38) + Got: ERROR + +315: "no bounds check for access to displaced array" + reported by Bruno Haible sbcl-devel "various SBCL bugs" from CLISP + test suite. + (locally (declare (optimize (safety 3) (speed 0))) + (let* ((x (make-array 10 :fill-pointer 4 :element-type 'character + :initial-element #\space :adjustable t)) + (y (make-array 10 :fill-pointer 4 :element-type 'character + :displaced-to x))) + (adjust-array x '(5)) + (char y 5))) + + SBCL 0.8.10 elides the bounds check somewhere along the line, and + returns #\Nul (where an error would be much preferable, since a test + of that form but with (setf (char y 5) #\Space) potentially corrupts + the heap and certainly confuses the world if that string is used by + C code. + +316: "SHIFTF and multiple values" + reported by Bruno Haible sbcl-devel "various SBCL bugs" from CLISP + test suite. + (shiftf (values x y) (values y x)) + gives an error in sbcl-0.8.10. + + Parts of the explanation of SHIFTF in ANSI CL talk about multiple + store variables, and the X3J13 vote + SETF-MULTIPLE-STORE-VARIABLES:ALLOW also says that SHIFTF should + support multiple value places. + +317: "FORMAT of floating point numbers" + reported by Bruno Haible sbcl-devel "various SBCL bugs" from CLISP + test suite. + (format nil "~1F" 10) => "0." ; "10." expected + (format nil "~0F" 10) => "0." ; "10." expected + (format nil "~2F" 1234567.1) => "1000000." ; "1234567." expected + it would be nice if whatever fixed this also untangled the two + competing implementations of floating point printing (Steele and + White, and Burger and Dybvig) present in src/code/print.lisp + +318: "stack overflow in compiler warning with redefined class" + reported by Bruno Haible sbcl-devel "various SBCL bugs" from CLISP + test suite. + (setq *print-pretty* nil) + (defstruct foo a) + (setf (find-class 'foo) nil) + (defstruct foo slot-1) + gives + ...#tradix.press. DO NOT EVEN THINK OF ATTEMPTING TO ;;; UNDERSTAND THIS CODE WITHOUT READING THE PAPER! +(declaim (type (simple-array character (10)) *digits*)) (defvar *digits* "0123456789") (defun flonum-to-string (x &optional width fdigits scale fmin) @@ -1387,6 +1388,96 @@ ;; all done (values digit-string (1+ digits) (= decpnt 0) (= decpnt digits) decpnt))) +;;; implementation of figure 1 from Burger and Dybvig, 1996. As the +;;; implementation of the Dragon from Classic CMUCL (and above, +;;; FLONUM-TO-STRING) says: "DO NOT EVEN THINK OF ATTEMPTING TO +;;; UNDERSTAND THIS CODE WITHOUT READING THE PAPER!", and in this case +;;; we have to add that even reading the paper might not bring +;;; immediate illumination as CSR has attempted to turn idiomatic +;;; Scheme into idiomatic Lisp. +;;; +;;; FIXME: figure 1 from Burger and Dybvig is the unoptimized +;;; algorithm, noticeably slow at finding the exponent. Figure 2 has +;;; an improved algorithm, but CSR ran out of energy +;;; +;;; FIXME: Burger and Dybvig also provide an algorithm for +;;; fixed-format floating point printing. If it were implemented, +;;; then we could delete the Dragon altogether (see FLONUM-TO-STRING). +;;; +;;; possible extension for the enthusiastic: printing floats in bases +;;; other than base 10. +(defconstant single-float-min-e + (nth-value 1 (decode-float least-positive-single-float))) +(defconstant double-float-min-e + (nth-value 1 (decode-float least-positive-double-float))) +#!+long-float +(defconstant long-float-min-e + (nth-value 1 (decode-float least-positive-long-float))) + +(defun flonum-to-digits (v) + (let ((print-base 10) ; B + (float-radix 2) ; b + (float-digits (float-digits v)) ; p + (min-e + (etypecase v + (single-float single-float-min-e) + (double-float double-float-min-e) + #!+long-float + (long-float long-float-min-e)))) + (multiple-value-bind (f e) + (integer-decode-float v) + (let (;; FIXME: these even tests assume normal IEEE rounding + ;; mode. I wonder if we should cater for non-normal? + (high-ok (evenp f)) + (low-ok (evenp f)) + (result (make-array 50 :element-type 'base-char + :fill-pointer 0 :adjustable t))) + (labels ((scale (r s m+ m-) + (do ((k 0 (1+ k)) + (s s (* s print-base))) + ((not (or (> (+ r m+) s) + (and high-ok (= (+ r m+) s)))) + (do ((k k (1- k)) + (r r (* r print-base)) + (m+ m+ (* m+ print-base)) + (m- m- (* m- print-base))) + ((not (or (< (* (+ r m+) print-base) s) + (and high-ok (= (* (+ r m+) print-base) s)))) + (values k (generate r s m+ m-))))))) + (generate (r s m+ m-) + (let (d tc1 tc2) + (tagbody + loop + (setf (values d r) (truncate (* r print-base) s)) + (setf m+ (* m+ print-base)) + (setf m- (* m- print-base)) + (setf tc1 (or (< r m-) (and low-ok (= r m-)))) + (setf tc2 (or (> (+ r m+) s) + (and high-ok (= (+ r m+) s)))) + (when (or tc1 tc2) + (go end)) + (vector-push-extend (char *digits* d) result) + (go loop) + end + (let ((d (cond + ((and (not tc1) tc2) (1+ d)) + ((and tc1 (not tc2)) d) + (t ; (and tc1 tc2) + (if (< (* r 2) s) d (1+ d)))))) + (vector-push-extend (char *digits* d) result) + (return-from generate result)))))) + (if (>= e 0) + (if (/= f (expt float-radix (1- float-digits))) + (let ((be (expt float-radix e))) + (scale (* f be 2) 2 be be)) + (let* ((be (expt float-radix e)) + (be1 (* be float-radix))) + (scale (* f be1 2) (* float-radix 2) be1 be))) + (if (or (= e min-e) (/= f (expt float-radix (1- float-digits)))) + (scale (* f 2) (* (expt float-radix (- e)) 2) 1 1) + (scale (* f float-radix 2) + (* (expt float-radix (- 1 e)) 2) float-radix 1)))))))) + ;;; Given a non-negative floating point number, SCALE-EXPONENT returns ;;; a new floating point number Z in the range (0.1, 1.0] and an ;;; exponent E such that Z * 10^E is (approximately) equal to the @@ -1451,6 +1542,12 @@ ;;; attractive to handle exponential notation with the same accuracy ;;; as non-exponential notation, using the method described in the ;;; Steele and White paper. +;;; +;;; NOTE II: this has been bypassed slightly by implementing Burger +;;; and Dybvig, 1996. When someone has time (KLUDGE) they can +;;; probably (a) implement the optimizations suggested by Burger and +;;; Dyvbig, and (b) remove all vestiges of Dragon4, including from +;;; fixed-format printing. ;;; Print the appropriate exponent marker for X and the specified exponent. (defun print-float-exponent (x exp stream) @@ -1508,26 +1605,34 @@ (write-string "0.0" stream) (print-float-exponent x 0 stream)) (t - (output-float-aux x stream (float 1/1000 x) (float 10000000 x)))))))) + (output-float-aux x stream -3 8))))))) (defun output-float-aux (x stream e-min e-max) - (if (and (>= x e-min) (< x e-max)) - ;; free format - (multiple-value-bind (str len lpoint tpoint) (flonum-to-string x) - (declare (ignore len)) - (when lpoint (write-char #\0 stream)) - (write-string str stream) - (when tpoint (write-char #\0 stream)) - (print-float-exponent x 0 stream)) - ;; exponential format - (multiple-value-bind (f ex) (scale-exponent x) - (multiple-value-bind (str len lpoint tpoint) - (flonum-to-string f nil nil 1) - (declare (ignore len)) - (when lpoint (write-char #\0 stream)) - (write-string str stream) - (when tpoint (write-char #\0 stream)) - ;; Subtract out scale factor of 1 passed to FLONUM-TO-STRING. - (print-float-exponent x (1- ex) stream))))) + (multiple-value-bind (e string) + (flonum-to-digits x) + (cond + ((< e-min e e-max) + (if (plusp e) + (progn + (write-string string stream :end (min (length string) e)) + (dotimes (i (- e (length string))) + (write-char #\0 stream)) + (write-char #\. stream) + (write-string string stream :start (min (length string) e)) + (when (<= (length string) e) + (write-char #\0 stream)) + (print-float-exponent x 0 stream)) + (progn + (write-string "0." stream) + (dotimes (i (- e)) + (write-char #\0 stream)) + (write-string string stream) + (print-float-exponent x 0 stream)))) + (t (write-string string stream :end 1) + (write-char #\. stream) + (write-string string stream :start 1) + (when (= (length string) 1) + (write-char #\0 stream)) + (print-float-exponent x (1- e) stream))))) ;;;; other leaf objects diff --git a/src/code/reader.lisp b/src/code/reader.lisp index 7fc9cd1..b5c5e73 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -1272,46 +1272,10 @@ (#\F 'single-float) (#\D 'double-float) (#\L 'long-float))) - num) - ;; Raymond Toy writes: We need to watch out if the - ;; exponent is too small or too large. We add enough to - ;; EXPONENT to make it within range and scale NUMBER - ;; appropriately. This should avoid any unnecessary - ;; underflow or overflow problems. - (multiple-value-bind (min-expo max-expo) - ;; FIXME: These forms are broken w.r.t. - ;; cross-compilation portability, as the - ;; cross-compiler will call the host's LOG function - ;; while attempting to constant-fold. Maybe some sort - ;; of load-time-form magic could be used instead? - (case float-format - ((short-float single-float) - (values - (log sb!xc:least-positive-normalized-single-float 10f0) - (log sb!xc:most-positive-single-float 10f0))) - ((double-float #!-long-float long-float) - (values - (log sb!xc:least-positive-normalized-double-float 10d0) - (log sb!xc:most-positive-double-float 10d0))) - #!+long-float - (long-float - (values - (log sb!xc:least-positive-normalized-long-float 10l0) - (log sb!xc:most-positive-long-float 10l0)))) - (let ((correction (cond ((<= exponent min-expo) - (ceiling (- min-expo exponent))) - ((>= exponent max-expo) - (floor (- max-expo exponent))) - (t - 0)))) - (incf exponent correction) - (setf number (/ number (expt 10 correction))) - (setq num (make-float-aux number divisor float-format stream)) - (setq num (* num (expt 10 exponent))) - (return-from make-float (if negative-fraction - (- num) - num)))))) - ;; should never happen + (result (make-float-aux (* (expt 10 exponent) number) + divisor float-format stream))) + (return-from make-float + (if negative-fraction (- result) result)))) (t (bug "bad fallthrough in floating point reader"))))) (defun make-float-aux (number divisor float-format stream) diff --git a/tests/print.impure.lisp b/tests/print.impure.lisp index 2ccd7ff..bbaf4cb 100644 --- a/tests/print.impure.lisp +++ b/tests/print.impure.lisp @@ -220,5 +220,16 @@ (assert (and w-p f-p)) (assert (nth-value 1 (ignore-errors (funcall f))))) +;;; floating point print/read consistency +(let ((x (/ -9.349640046247849d-21 -9.381494249123696d-11))) + (let ((y (read-from-string (write-to-string x :readably t)))) + (assert (eql x y)))) + +(let ((x1 (float -5496527/100000000000000000)) + (x2 (float -54965272/1000000000000000000))) + (assert (or (equal (multiple-value-list (integer-decode-float x1)) + (multiple-value-list (integer-decode-float x2))) + (string/= (prin1-to-string x1) (prin1-to-string x2))))) + ;;; success (quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index 3dbc98f..94b8d0a 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.10.18" +"0.8.10.19"