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
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)
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.
+ ;; <http://www.lisp.org/HyperSpec/Body/sec_6-1-7-2.html>
+ ;; 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
+ ...#<SB-KERNEL:STRUCTURE-CLASSOID #<SB-KERNEL:STRUCTURE-CLASSOID #<SB-KERNEL:STRUCTURE-CLASSOID #<SB-KERNEL:STRUCTUREControl stack guard page temporarily disabled: proceed with caution
+ (it's not really clear what it should give: is (SETF FIND-CLASS)
+ meant to be enough to delete structure classes from the system?
+ Giving a stack overflow is definitely suboptimal, though.)
+
+319: "backquote with comma inside array"
+ reported by Bruno Haible sbcl-devel "various SBCL bugs" from CLISP
+ test suite.
+ (read-from-string "`#1A(1 2 ,(+ 2 2) 4)")
+ gives
+ #(1 2 ((SB-IMPL::|,|) + 2 2) 4)
+ which probably isn't intentional.
+
+320: "shared to local slot in class redefinition"
+ reported by Bruno Haible sbcl-devel "various SBCL bugs" from CLISP
+ test suite.
+ ;; Shared slot becomes local.
+ ;; 4.3.6.1.: "The value of a slot that is specified as shared in
+ ;; the old class and as local in the new class is retained."
+ (multiple-value-bind (value condition)
+ (ignore-errors
+ (defclass foo85a ()
+ ((size :initarg :size :initform 1 :allocation :class)))
+ (defclass foo85b (foo85a) ())
+ (setq i (make-instance 'foo85b))
+ (defclass foo85a () ((size :initarg :size :initform 2) (other)))
+ (slot-value i 'size))
+ (list value (type-of condition)))
+ should return (1 NULL) but returns (2 NULL) in sbcl-0.8.10. See
+ ensuing discussion sbcl-devel for how to deal with this.
+
+321: "DEFINE-METHOD-COMBINATION lambda list parsing"
+ reported by Bruno Haible sbcl-devel "various SBCL bugs" from CLISP
+ test suite.
+ (define-method-combination w-args ()
+ ((method-list *))
+ (:arguments arg1 arg2 &aux (extra :extra))
+ `(progn ,@(mapcar (lambda (method) `(call-method ,method)) method-list)))
+ gives a (caught) compile-time error, which can be exposed by
+ (defgeneric mc-test-w-args (p1 p2 s)
+ (:method-combination w-args)
+ (:method ((p1 number) (p2 t) s)
+ (vector-push-extend (list 'number p1 p2) s))
+ (:method ((p1 string) (p2 t) s)
+ (vector-push-extend (list 'string p1 p2) s))
+ (:method ((p1 t) (p2 t) s) (vector-push-extend (list t p1 p2) s)))
+
+322: "DEFSTRUCT :TYPE LIST predicate and improper lists"
+ reported by Bruno Haible sbcl-devel "various SBCL bugs" from CLISP
+ test suite.
+ (defstruct (a (:type list) (:initial-offset 5) :named))
+ (defstruct (b (:type list) (:initial-offset 2) :named (:include a)))
+ (b-p (list* nil nil nil nil nil 'foo73 nil 'tail))
+ gives an error in sbcl-0.8.10
* fixed some bugs revealed by Paul Dietz' test suite:
** FILE-POSITION works as specified on BROADCAST-STREAMs.
** CAST optimizer forgot to flush argument derived type.
-
+ ** print/read consistency on floats is now orders of magnitude
+ more likely. (thanks also to Bruno Haible for a similar report
+ and discussions)
+
planned incompatible changes in 0.8.x:
* (not done yet, but planned:) When the profiling interface settles
down, it might impact TRACE. They both encapsulate functions, and
;;; [CMUC]<steele>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)
;; 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))))))))
+\f
;;; 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
;;; 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)
(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)))))
\f
;;;; other leaf objects
(#\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)
(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)
;;; 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"
projects / sbcl.git / commitdiff